☰

使用组合框条件复制范围

tag-icon • tag-icon microsoft-excel vba
使用组合框条件复制范围

我正在尝试从用户表单上的两个组合框复制满足两个条件的范围。

ComboBox1 包含条件 1，即 Branch。ComboBox2
包含条件 2，即 Quarter。

列A需要符合分支标准，行1需要符合季度标准。

射程图像

我无法使代码正常工作。它仅从列中复制数据2，并未检查整行是否符合季度标准。

例如，如果我选择 Pearl 分支和季度 Q1，代码应该复制“apple”和“8”。

以下是代码：

Private Sub CommandButton1_Click()

Dim LastRow As Long, i As Long, ws2 As Worksheet

With Worksheets("Sheet1")
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row

    For i = 2 To LastRow

        If .Cells(i, 1) = ComboBox1 And .Cells(1, 2) = ComboBox2 Then
            With Worksheets("Sheet4")
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = _
                     Worksheets("Sheet1").Cells(i, 2).Value
            End With
        End If

    Next i
End With
Unload Me

End Sub

答案1

您的代码的主要问题是，虽然您正确地循环遍历行，但却没有循环遍历列。

添加内部循环可以解决这个问题。但是，更好的解决方案是使用工作表函数MATCH()查找匹配的行，然后循环遍历列反而：

Private Sub CommandButton1_Click()

Dim LastColumn As Long
Dim i As Long

With Worksheets("Sheet1")
    LastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
    Dim lngMatchingRow As Long
    lngMatchingRow = Excel.WorksheetFunction.Match(ComboBox1.Value, .Range("A:A"), 0)

    For i = 2 To LastColumn

        If .Cells(1, i).Value2 = ComboBox2.Value Then
            With Worksheets("Sheet4")
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0) = _
                     Worksheets("Sheet1").Cells(lngMatchingRow, i).Value2
            End With
        End If

    Next i
End With
Unload Me

End Sub

请注意，我擅自修改了代码的其他部分以遵循最佳实践：

  • 每行应声明一个变量
  • 变量应尽可能在第一次使用时声明
  • .Value2.Value从电子表格中提取数据时，始终优先使用 show
  • 不应依赖默认属性，而应明确指定，ComboBox1.Value例如ComboBox1

现在，如果我从头开始编写代码，并且保证将 Quarters 组合在一起，那么我也会省去列循环。

相反，我会使用MATCH()和COUNTIF()来找到列限制并一次性复制所有数据：

Private Sub CommandButton1_Click()
        Dim ƒ As Excel.WorksheetFunction: Set ƒ = Excel.WorksheetFunction

  With Worksheets("Sheet1")
    Dim lngMatchingRow As Long
    lngMatchingRow = ƒ.Match(ComboBox1.Value, .Range("A:A"), 0)
    Dim lngStartCol As Long
    lngStartCol = ƒ.Match(ComboBox2.Value, .Range("1:1"), 0)
    Dim lngColCount As Long
    lngColCount = ƒ.CountIf(.Range("1:1"), "Q1")

    Worksheets("Sheet4").Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(lngColCount) _
    = ƒ.Transpose(.Cells(lngMatchingRow, lngStartCol).Resize(1, lngColCount).Value2)

  End With
  Unload Me

End Sub

相关内容