根据用户表单自动填充单元格区域

Question

我已经为用户窗体构建了代码，它将根据场景完成某些任务。一切正常，但我为场景 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

Answer 1

为了补充我的评论，我冒昧地修复了您的代码：

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

编辑：目标必须包括源范围。

EDIT2: 修复了代码中的一些问题

使用调试器检查范围是否符合您的预期，即：

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

根据用户表单自动填充单元格区域

Autofill an area of cells dependant on the userform

excel

vba

autofill

userform