VBA Macro worksheet_change не работает должным образом - PullRequest
0 голосов
/ 05 марта 2020

У меня проблема с правильно работающим макросом. Я написал короткий и простой код для скрытия или отображения двух последних столбцов в зависимости от выбранного месяца.

Выбор месяца возможен с помощью поля со списком. Каждому месяцу присваивается номер (1 - январь, 2 - февраль, ... и т. Д. c.). Число отображается в ячейке A1 и изменяется при выборе месяца.

Я хочу, чтобы мой макрос работал правильно в зависимости от выбранного месяца.

    Private Sub Worksheet_Change(ByVal Target As Range)
          Dim nr_kol As Long
          If Target.Address = "$A$1" Then
            For nr_kol = 32 To 34
                If Month(Cells(6, nr_kol)) = Cells(1, 1) Then
                    Columns(nr_kol).Hidden = False
                Else
                    Columns(nr_kol).Hidden = True
                End If
            Next
        End If

    End Sub

РЕДАКТИРОВАТЬ (извините, нажали кнопку отправки слишком быстро)

Ячейка A1 изменяется в зависимости от выбора в выпадающем списке (поле расположено в другой строке). Я заметил, что столбцы будут скрыты, но только если ячейка A1 будет изменена вручную. Но когда я изменяю ячейку на индекс месяца, содержащий 30 или 31 день, столбцы остаются скрытыми, поэтому у меня возникают две проблемы.

  1. Ячейку A1 необходимо изменить вручную (макрос не работает что бы ни происходило, когда изменения производятся с помощью выбора в выпадающем списке)

  2. Когда я вручную изменяю на февраль - два или три последних столбца будут скрыты (как это происходит в течение первых двух / трех дней Марш). Однако, когда я изменяю число на что-либо, кроме февраля (2), столбцы по-прежнему скрыты, даже если хотя бы один из них должен появиться снова (если месяц содержит 30 дней).

1 Ответ

0 голосов
/ 05 марта 2020

ниже изображение и его объяснение

enter image description here

  1. Добавьте комбинированный список
  2. Строка 1 будет содержать месяцы в этом формат
  3. Строка 2 будет содержать даты месяца, убедитесь, что между датами нет пустой ячейки

код, указанный ниже

Option Explicit
Dim monthsList(11) As String
Dim firstCell As Integer
Dim lastCell As Integer

Private Sub ComboBox1_Change()

    Columns("A:XX").Hidden = False

    '0 to reset the columns
    If ComboBox1.Value = 0 Then Exit Sub

    'take the last month of the list
    Dim var1() As String
    var1 = Split(monthsList(11), "~")

    firstCell = 4 'assuming that the start of the date begins from column 4
    lastCell = Val(var1(2))

    Range(Cells(firstCell, firstCell), Cells(firstCell, lastCell)).EntireColumn.Hidden = True

    Erase var1

    var1 = Split(monthsList(ComboBox1.Value - 1), "~")

    firstCell = Val(var1(1))
    lastCell = Val(var1(2))

    'display only current selected month
    Range(Cells(firstCell, firstCell), Cells(firstCell, lastCell)).EntireColumn.Hidden = False

End Sub


Private Sub Worksheet_Activate()

    Erase monthsList

    'unhide any columns or write a macro that recognises the hidden columns and keeps it hidden
    Columns("A:XX").Hidden = False
    Dim i As Integer
    ComboBox1.Clear
    For i = 0 To 12
        ComboBox1.AddItem i
    Next

    '0 added to display all the sheets

    ComboBox1.Select (1)

    'let this be the start of the date range
    'select the cell in the second row
    Range("D2").Select

    'go to the last date
    Selection.End(xlToRight).Select

    'go to the first row
    ActiveCell.Offset(-1, 0).Select

    lastCell = ActiveCell.Column
    'select the last month
    Selection.End(xlToLeft).Select

    For i = 12 To 1 Step -1
                            'cell value             start date of the month     last date of the month
        monthsList(i - 1) = ActiveCell.Value & "~" & ActiveCell.Column & "~" & lastCell
        lastCell = ActiveCell.Column - 1
        Selection.End(xlToLeft).Select
    Next

End Sub

Обратите внимание, что вам необходимо внести необходимые изменения по мере необходимости

Я надеюсь, что это решит вашу боль

Пожалуйста, отметьте это как ответ

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...