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

Posted 2023-02-24

【中文标题】根据用户表单自动填充单元格区域

【英文标题】：Autofill an area of cells dependant on the userform

【发布时间】：2019-06-04 19:05:55

【问题描述】：

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

【问题讨论】：

您错过了一些不完全合格的Rows.Count，可能是您问题的根源？即：ThisWorkbook.Sheets("MFRL").Cells(Rows.Count, "B")... 评估为ThisWorkbook.Sheets("MFRL").Cells(ActiveSheet.Rows.Count, "B")... 这可能会起作用，因为Sheets("MFRL") 是您的活动表......但对于其他人......

我已经编辑了你的代码，但不能确定正确的范围，我只是修复了明显的部分。我不明白为什么边界会起作用，因为您的 Rows.Count 仍然是 ActiveSheet.Rows.Count。

【参考方案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

【讨论】：

我试图合并您的代码，但似乎没有任何反应。您是否发现自边界工作以来似乎关闭的自动填充有什么问题？谢谢

老实说，我真的看不出有什么不对...我已经更正了一些重复的调整大小，但除此之外，没有看到工作表或不知道你期望看到什么，很难我猜。我在答案中添加了一种调试方法......看看它是否有帮助。

在我看来你只是想复制整个值？不应使用自动填充，而应使用 Range.Value = Range.Value。或者如果你想要公式，那么Range.Formula = Range.Formula`...

对，您要填充哪些范围？ MFRL 的 CT 和 JH 表？或 CT & JH 的 MFRL？因为目前您的代码只是填充（或尝试）工作表 MFRL。

让我们continue this discussion in chat.