Автозаполнение области ячеек зависит от формы пользователя - PullRequest
Новая
       19

Автозаполнение области ячеек зависит от формы пользователя

0 голосов
/ 04 июня 2019

Я создал код для пользовательской формы, который будет выполнять определенные задачи в зависимости от сценария. Все работает, но код автозаполнения, который у меня есть для сценария 3 (Sheets JH и CT), не работает. В то же время в том же сценарии автозаполнение для листа MRFL выполняется в соответствии с запросом. 

Private Sub CommandButton1_Click()

Dim ColA As New Scripting.Dictionary  'Need Microsoft Scripting Runtime Reference
Dim ColB As New Scripting.Dictionary
Dim LastRow As Long
Dim Criteria1 As Boolean
Dim Criteria2 As Boolean
Dim C As Range




With ThisWorkbook.Sheets("MFRL")
    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'This gets the last row on column A
    For Each C In .Range("A1:A" & LastRow) 'loop through the whole column
    On Error Resume Next
        'If you have duplicated entries this will throw an error
        ColA.Add C.Value, C.Row 'add the values from column A to DictA, also store it's row for later purposes
        ColB.Add C.Offset(0, 1).Value, C.Row 'add the values from column B to DictB, also store it's row for later purposes
    Next C
    'Criterias will give value of True if matched or False if not
    Criteria1 = ColA.Exists(ComboBox2.Value) 'this is getting matched with ColA Dictionary
    Criteria2 = ColB.Exists(ComboBox1.Value) 'this is getting matched with ColB Dictionary
    If Criteria1 And Criteria2 Then 'SCENARIO 1
       Call linepick
    ElseIf Criteria1 And Not Criteria2 Then 'SCENARIO 2
        .Cells(LastRow + 1, 1) = ComboBox2.Value
        .Cells(LastRow + 1, 2) = ComboBox1.Value
         Call linepick
        ThisWorkbook.Sheets("MFRL").Cells(Rows.Count, "B").End(xlUp).Offset(-1, 1).Resize(, 3).AutoFill .Cells(Rows.Count, "B").End(xlUp).Offset(-1, 1).Resize(, 3).Resize(2)
        ThisWorkbook.Sheets("MFRL").Cells(Rows.Count, "A").End(xlUp).Offset(-1, 0).Resize(, 5).Resize(2).Borders.LineStyle = xlContinuous
    ElseIf Not Criteria1 And Not Criteria2 Then 'SCENARIO 3
        .Cells(LastRow + 1, 1) = ComboBox2.Value
        .Cells(LastRow + 1, 2) = ComboBox1.Value
        LastRow = ThisWorkbook.Sheets("CT").Cells(ThisWorkbook.Sheets("CT").Rows.Count, 1).End(xlUp).Row + 1
        ThisWorkbook.Sheets("CT").Cells(LastRow, 1) = ComboBox2.Value
        ThisWorkbook.Sheets("CT").Cells(Rows.Count, "A").End(xlUp).Offset(-1, 1).Resize(, 21).AutoFill .Cells(Rows.Count, "A").End(xlUp).Offset(-1, 1).Resize(, 21).Resize(2)
        ThisWorkbook.Sheets("CT").Cells(Rows.Count, "A").End(xlUp).Offset(-1, 0).Resize(, 21).Resize(2).Borders.LineStyle = xlContinuous
        LastRow = ThisWorkbook.Sheets("JH").Cells(ThisWorkbook.Sheets("JH").Rows.Count, 1).End(xlUp).Row + 1
        ThisWorkbook.Sheets("JH").Cells(LastRow, 1) = ComboBox2.Value
        ThisWorkbook.Sheets("JH").Cells(LastRow, "AE") = TextBox1.Value
        ThisWorkbook.Sheets("JH").Cells(Rows.Count, "AE").End(xlUp).Offset(0, 1).Resize(, 4).AutoFill .Cells(Rows.Count, "AE").End(xlUp).Offset(0, 1).Resize(, 4).Resize(2)
        ThisWorkbook.Sheets("JH").Cells(Rows.Count, "A").End(xlUp).Offset(-1, 0).Resize(, 44).Resize(2).Borders.LineStyle = xlContinuous
        ThisWorkbook.Sheets("MFRL").Cells(LastRow, 1) = ComboBox2.Value
        ThisWorkbook.Sheets("MFRL").Cells(LastRow, 2) = ComboBox1.Value
        ThisWorkbook.Sheets("MFRL").Cells(Rows.Count, "B").End(xlUp).Offset(-1, 1).Resize(, 3).AutoFill .Cells(Rows.Count, "B").End(xlUp).Offset(-1, 1).Resize(, 3).Resize(2)
        ThisWorkbook.Sheets("MFRL").Cells(Rows.Count, "A").End(xlUp).Offset(-1, 0).Resize(, 5).Resize(2).Borders.LineStyle = xlContinuous
    End If
 End With
 ActiveWorkbook.RefreshAll
 Unload Me
 End Sub

1 Ответ

1 голос
/ 04 июня 2019

Чтобы добавить мой комментарий, я позволил себе исправить ваш код: 

Private Sub CommandButton1_Click()

Dim ColA As New Scripting.Dictionary  'Need Microsoft Scripting Runtime Reference
Dim ColB As New Scripting.Dictionary
Dim LastRow As Long
Dim Criteria1 As Boolean
Dim Criteria2 As Boolean
Dim C As Range

Dim wb As Workbook: Set wb = ThisWorkbook

With wb.Sheets("MFRL")
    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'This gets the last row on column A
    For Each C In .Range("A1:A" & LastRow) 'loop through the whole column
    On Error Resume Next
        'If you have duplicated entries this will throw an error
        ColA.Add C.Value, C.Row 'add the values from column A to DictA, also store it's row for later purposes
        ColB.Add C.Offset(0, 1).Value, C.Row 'add the values from column B to DictB, also store it's row for later purposes
    Next C
    'Criterias will give value of True if matched or False if not
    Criteria1 = ColA.Exists(ComboBox2.Value) 'this is getting matched with ColA Dictionary
    Criteria2 = ColB.Exists(ComboBox1.Value) 'this is getting matched with ColB Dictionary
    If Criteria1 And Criteria2 Then 'SCENARIO 1
        Call linepick

    ElseIf Criteria1 And Not Criteria2 Then 'SCENARIO 2
        .Cells(LastRow + 1, 1) = ComboBox2.Value
        .Cells(LastRow + 1, 2) = ComboBox1.Value
        Call linepick
        .Cells(LastRow, "B").Offset(-1, 1).Resize(, 3).AutoFill .Cells(LastRow, "B").Offset(-1, 1).Resize(2, 3)
        .Cells(LastRow, "A").Offset(-1, 0).Resize(2, 5).Borders.LineStyle = xlContinuous

    ElseIf Not Criteria1 And Not Criteria2 Then 'SCENARIO 3
        .Cells(LastRow + 1, 1) = ComboBox2.Value
        .Cells(LastRow + 1, 2) = ComboBox1.Value
        .Cells(LastRow, "B").Offset(-1, 1).Resize(, 3).AutoFill .Cells(LastRow, "B").Offset(-1, 1).Resize(2, 3)
        .Cells(LastRow, "A").Offset(-1, 0).Resize(2, 5).Borders.LineStyle = xlContinuous

        With wb.Sheets("CT")
            LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            .Cells(LastRow, 1) = ComboBox2.Value
            .Cells(LastRow, "A").Offset(-1, 1).Resize(, 21).AutoFill .Cells(LastRow, "A").Offset(-1, 1).Resize(2, 21)
            .Cells(LastRow, "A").Resize(1, 22).Borders.LineStyle = xlContinuous
        End With

        With wb.Sheets("JH")
            LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
            .Cells(LastRow, 1) = ComboBox2.Value
            .Cells(LastRow, "AE") = TextBox1.Value
            .Cells(LastRow, "AE").Offset(-1, 1).Resize(, 4).AutoFill .Cells(LastRow, "AE").Offset(-1, 1).Resize(2, 4)
            .Cells(LastRow, "A").Offset(-1, 0).Resize(2, 44).Borders.LineStyle = xlContinuous
        End With
    End If
End With

    wb.RefreshAll
    Unload Me
End Sub

РЕДАКТИРОВАТЬ: В пункте назначения должен быть указан диапазон источника.

РЕДАКТИРОВАТЬ 2: исправлены некоторые проблемы в коде

Используйте отладчик, чтобы проверить, соответствуют ли диапазоны ожидаемым, то есть: 

Debug.Print "CT Range: " & .Cells(.Rows.Count, "A").End(xlUp).Offset(-1, 1).Resize(, 21).Address
Debug.Print "MFRL Range: " & wb.Sheets("MFRL").Cells(wb.Sheets("MFRL").Rows.Count, "A").End(xlUp).Offset(-1, 1).Resize(2, 21).Address
...