Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) a = Target.Column b = Target.Interior.Color c = Target.Row s = Application.Match("ИТОГО", Range("b" & c + 1 & ":b127999"), 0) t = Application.IsNumber(s) If t Then u = s + c Else u = Cells(Rows.Count, "e").End(xlUp).Row End If If a = 1 And b = 65535 Then For x = c + 1 To u y = Range("e" & x).Value If y = "" Then Rows(x).EntireRow.Hidden = True Next End If If a = 7 Then Rows(c + 1 & ":" & u).EntireRow.Hidden = False Cancel = True End Sub
[/vba]наверное
так: [vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) a = Target.Column b = Target.Interior.Color c = Target.Row s = Application.Match("ИТОГО", Range("b" & c + 1 & ":b127999"), 0) t = Application.IsNumber(s) If t Then u = s + c Else u = Cells(Rows.Count, "e").End(xlUp).Row End If If a = 1 And b = 65535 Then For x = c + 1 To u y = Range("e" & x).Value If y = "" Then Rows(x).EntireRow.Hidden = True Next End If If a = 7 Then Rows(c + 1 & ":" & u).EntireRow.Hidden = False Cancel = True End Sub
Nic70y, почти, в файле добавил строки, если возможно сделать, чтоб строки скрывались в выбранных блоках. Сейчас при нажатии на А9 скрываются все пустые строки до строки Итого.
Nic70y, почти, в файле добавил строки, если возможно сделать, чтоб строки скрывались в выбранных блоках. Сейчас при нажатии на А9 скрываются все пустые строки до строки Итого.Смольный
Nic70y, Может это уже перебор, но все таки спрошу, а вдруг возможно. Можно ли сделать так, чтоб в столбце А после скрытия пустых строк, подсчет шел только оставшихся?
Nic70y, Может это уже перебор, но все таки спрошу, а вдруг возможно. Можно ли сделать так, чтоб в столбце А после скрытия пустых строк, подсчет шел только оставшихся?Смольный
Смольный, не заморачивался, записал формулы рекордером [vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) a = Target.Column b = Target.Interior.Color c = Target.Row s = Application.Match("*", Range("a" & c + 1 & ":a127999"), 0) - 1 t = Application.IsNumber(s) If t Then u = s + c Else u = Cells(Rows.Count, "e").End(xlUp).Row - 1 End If If a = 1 And b = 65535 Then For x = c + 1 To u y = Range("e" & x).Value If y = "" Then Rows(x).EntireRow.Hidden = True Next Range("a" & c + 1 & ":a" & u).FormulaR1C1 = "=IF(RC[4],MAX(R9C:R[-1]C)+1,0)" End If If a = 7 And b = 65535 Then Rows(c + 1 & ":" & u).EntireRow.Hidden = False Range("a" & c + 1 & ":a" & u).FormulaR1C1 = "=MAX(R9C:R[-1]C)+1" End If Cancel = True End Sub
[/vba]
Смольный, не заморачивался, записал формулы рекордером [vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) a = Target.Column b = Target.Interior.Color c = Target.Row s = Application.Match("*", Range("a" & c + 1 & ":a127999"), 0) - 1 t = Application.IsNumber(s) If t Then u = s + c Else u = Cells(Rows.Count, "e").End(xlUp).Row - 1 End If If a = 1 And b = 65535 Then For x = c + 1 To u y = Range("e" & x).Value If y = "" Then Rows(x).EntireRow.Hidden = True Next Range("a" & c + 1 & ":a" & u).FormulaR1C1 = "=IF(RC[4],MAX(R9C:R[-1]C)+1,0)" End If If a = 7 And b = 65535 Then Rows(c + 1 & ":" & u).EntireRow.Hidden = False Range("a" & c + 1 & ":a" & u).FormulaR1C1 = "=MAX(R9C:R[-1]C)+1" End If Cancel = True End Sub