Добрый день! Подскажите пожалуйста как можно решить задачу? Есть таблица с данными в разрезе по месяцам. В сентябре, к примеру, сумма указана, а в октябре нет. Как можно сделать, чтобы при выборе октября скрывались строки по которым нет суммы. И так по остальным месяцам. Чтобы можно было скрыть кнопкой все месяца кроме одного, но чтобы при этом и строки скрылись лишние, по которым нет суммы.
Добрый день! Подскажите пожалуйста как можно решить задачу? Есть таблица с данными в разрезе по месяцам. В сентябре, к примеру, сумма указана, а в октябре нет. Как можно сделать, чтобы при выборе октября скрывались строки по которым нет суммы. И так по остальным месяцам. Чтобы можно было скрыть кнопкой все месяца кроме одного, но чтобы при этом и строки скрылись лишние, по которым нет суммы.anabioss13
двойной клик левой кнопки мыши по ячейке A1 вызовет ЮзерФорму
[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address = "$A$1" Then Cancel = True UserForm1.Show End If End Sub
[/vba]
сформируется список [vba]
Код
Private Sub UserForm_Initialize() a = Array("Январь", "Февраль", "Март", _ "Апрель", "Май", "Июнь", _ "Июль", "Август", "Сентябрь", _ "Октябрь", "Ноябрь", "Декабрь") ComboBox1.List = a End Sub
[/vba] при выборе месяца и нажатии кнопки сработает макрос [vba]
Код
Private Sub CommandButton1_Click() 'жмем на кнопу f = 8 'верхняя строка таблицы g = Cells(Rows.Count, "a").End(xlUp).Row 'нижняя строка таблицы Rows(f & ":" & g).EntireRow.Hidden = False 'отобразим строки x = 4 'строка с месяцами a = 4 'левый столбец с меяцем b = 6 'правый столбец с меяцем Range(Columns(a), Columns(b)).EntireColumn.Hidden = True 'скрываем столбцы c = ComboBox1.Value 'выбранный месяц d = Application.Match(c, Range(Cells(x, a), Cells(x, b)), 0) 'ищем выбранный месяц If IsNumeric(d) Then 'если нащли, тогда e = d + a - 1 'столбец соот. месяцу Columns(e).EntireColumn.Hidden = False 'отображаем столбец h = x - 1 'столбец с наименованиями 'пройдемся циклом от верхней до нижней строки For i = f To g j = Cells(i, h).Value 'наименование k = Cells(i, e).Value 'сумма 'если наименование - не пусто, а сумма - пусто, тогда скроем строку If j <> "" And k = "" Then Rows(i).EntireRow.Hidden = True Next End If Unload UserForm1 'закроем форму End Sub
[/vba]
двойной клик левой кнопки мыши по ячейке A1 вызовет ЮзерФорму
[vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Address = "$A$1" Then Cancel = True UserForm1.Show End If End Sub
[/vba]
сформируется список [vba]
Код
Private Sub UserForm_Initialize() a = Array("Январь", "Февраль", "Март", _ "Апрель", "Май", "Июнь", _ "Июль", "Август", "Сентябрь", _ "Октябрь", "Ноябрь", "Декабрь") ComboBox1.List = a End Sub
[/vba] при выборе месяца и нажатии кнопки сработает макрос [vba]
Код
Private Sub CommandButton1_Click() 'жмем на кнопу f = 8 'верхняя строка таблицы g = Cells(Rows.Count, "a").End(xlUp).Row 'нижняя строка таблицы Rows(f & ":" & g).EntireRow.Hidden = False 'отобразим строки x = 4 'строка с месяцами a = 4 'левый столбец с меяцем b = 6 'правый столбец с меяцем Range(Columns(a), Columns(b)).EntireColumn.Hidden = True 'скрываем столбцы c = ComboBox1.Value 'выбранный месяц d = Application.Match(c, Range(Cells(x, a), Cells(x, b)), 0) 'ищем выбранный месяц If IsNumeric(d) Then 'если нащли, тогда e = d + a - 1 'столбец соот. месяцу Columns(e).EntireColumn.Hidden = False 'отображаем столбец h = x - 1 'столбец с наименованиями 'пройдемся циклом от верхней до нижней строки For i = f To g j = Cells(i, h).Value 'наименование k = Cells(i, e).Value 'сумма 'если наименование - не пусто, а сумма - пусто, тогда скроем строку If j <> "" And k = "" Then Rows(i).EntireRow.Hidden = True Next End If Unload UserForm1 'закроем форму End Sub
А можно еще дописать, чтобы при выборе пустого значения в юзерформе т.е. без месяца, таблица разворачивалась в исходное положение со всеми данными?
А можно еще дописать, чтобы при выборе пустого значения в юзерформе т.е. без месяца, таблица разворачивалась в исходное положение со всеми данными?anabioss13
Сообщение отредактировал anabioss13 - Пятница, 26.07.2024, 12:51