vba excel将2列与第3列的条件进行比较

vba excel将2列与第3列的条件进行比较,excel,vba,Excel,Vba,在表1中,我有两列: 在表2中,我有一列: 在表3中,我希望得到以下结果: 获取Sheet3中数据的参数为:Sheet2中A列的值等于Sheet1中A列的值(可以是随机行#),如果它等于,则Sheet1中B列的值应为“A” 我写了以下内容: Sub MatchColumnsCondition() Dim sht1, sht2, sht3 As Worksheet Dim lr1, lr2, lr3 As Long Dim chk1, chk2 As Variant

在表1中,我有两列:

在表2中,我有一列:

在表3中,我希望得到以下结果:

获取Sheet3中数据的参数为:Sheet2中A列的值等于Sheet1中A列的值(可以是随机行#),如果它等于,则Sheet1中B列的值应为“A”

我写了以下内容:

Sub MatchColumnsCondition()

    Dim sht1, sht2, sht3 As Worksheet
    Dim lr1, lr2, lr3 As Long
    Dim chk1, chk2 As Variant
    Dim out3 As Range
    Dim dup As Boolean
    Dim i, j

    Set sht1 = ThisWorkbook.Worksheets("Sheet1") 'data to search in including condition
    Set sht2 = ThisWorkbook.Worksheets("Sheet2") 'data to search from
    Set sht3 = ThisWorkbook.Worksheets("Sheet3") 'output data

    lr1 = sht1.Cells(sht1.Rows.Count, "A").End(xlUp).Row
    lr2 = sht2.Cells(sht2.Rows.Count, "A").End(xlUp).Row
    lr3 = sht3.Cells(sht3.Rows.Count, "A").End(xlUp).Row

    Set chk1 = sht1.Range("A1:A" & lr1)
    Set chk2 = sht2.Range("A1:A" & lr2)
    Set out3 = sht3.Range("A1:A" & lr3)

    For i = LBound(chk1) To UBound(chk1)
           For j = LBound(chk2) To UBound(chk2)
            If chk1(i, 1) = chk2(j, 1) And chk1.Offset(, 1) = "a" Then
                sht3.Range("A" & lr3) = chk1(i, 1)
            End If
        Next j
    Next i

End Sub
但我一直在使用它时遇到错误,但我不知道如何使它正常工作。

继续使用您的代码

Sub MatchColumnsCondition()

    Dim sht1 As Worksheet, sht2 As Worksheet, sht3 As Worksheet
    Dim lr1 As Long, lr2 As Long
    Dim chk1 As Variant, chk2 As Variant
    Dim i As Long, j As Long

    Set sht1 = ThisWorkbook.Worksheets("Sheet1") 'data to search in including condition
    Set sht2 = ThisWorkbook.Worksheets("Sheet2") 'data to search from
    Set sht3 = ThisWorkbook.Worksheets("Sheet3") 'output data

    lr1 = sht1.Cells(sht1.Rows.Count, "A").End(xlUp).Row
    lr2 = sht2.Cells(sht2.Rows.Count, "A").End(xlUp).Row

     chk1 = sht1.Range("A1:B" & lr1).Value
     chk2 = sht2.Range("A1:A" & lr2).Value

    For i = LBound(chk1) To UBound(chk1)
           For j = LBound(chk2) To UBound(chk2)
            If chk1(i, 1) = chk2(j, 1) And chk1(i, 2) = "a" Then
                sht3.Cells(sht3.Rows.Count, "A").End(xlUp).Offset(1).Value = chk1(i, 1)
            End If
        Next
    Next

End Sub
其中,在原始代码中:

1)
Dim sht1、sht2、sht3作为工作表

实际上会导致:

Dim sht3作为工作表,sht1作为变量,sht2作为变量

由于未经验证声明的变量(
Dim sht1、sht2
,…)将被隐式假定为
变量
类型

因此,明确声明所有
工作表
类型变量,如
Dim sht1为工作表,sht2为工作表,sht3为工作表

2)
LBound(chk1)到UBound(chk1)
LBound(chk2)到UBound(chk2)

LBound()
UBound()
函数接受数组作为参数

要使数组超出
范围
,必须获取其
属性

然后

  • 可以使用
    Dim chk1,chk2作为变型
这将导致
Dim chk1作为变量,chk2作为变量,这很好,因为
Variant
是我们需要存储范围值的正确类型

  • Set chk1=sht1.Range(“A1:A”&lr1)
    会变成
    chk1=sht1.Range(“A1:B”&lr1).Value
    ,因为您不
    设置数组,也需要它来存储列B的值

  • Set chk2=sht2.Range(“A1:A”和lr1)
    变为
    chk2=sht2.Range(“A1:A”和lr1).Value

  • 您不需要
    out3
    ,因此不需要声明也不需要设置它

3)
Offset()
是一个
范围
类属性,而数组既没有方法也没有属性

要在2D数组的第二列中获得一些值,可以使用列索引,如
chk1(i,2)

最后)
sht3.Range(“A”&lr3)
会在同一个单元格中反复写入

因此,要么更新lr3(在
End If
之前使用一些
lr3=lr3+1
),要么需要一个动态范围引用,始终指向
sht3
列最后一个非空单元格之后的第一个空单元格,如
sht3.Cells(sht3.Rows.Count,“a”).End(xlUp).Offset(1)

编辑:添加了不同的方法

如果(根据显示的数据)Sheet1的B列有“a”或空白单元格,则可以避免循环,并使用
Range
对象的
AutoFilter()
Specialcells()
方法,如下所示(注释中的解释):


有帮助的,彻底的解释:+)非常感谢,不仅修复了我的代码,还感谢你的解释。事实证明,我比我想象的更接近,但主要的问题是我的模糊-忽略了变量。我的错误假设是,如果你把dim和逗号分开,然后以一个变量结尾——所有这些都是同一个变量。调整后的代码完全符合我的想法。如果我的数据与表1 B列中的“a”不同,则您的第二个代码无法正常工作。然后,它还将显示,如果列a中的值匹配,则为命中。也欢迎您。是的,你很接近,但对于我指出的三个问题。如果B列中所有不需要的单元格都为空,则第二个代码可以工作
Sub MatchColumnsCondition2()

    Dim sht1 As Worksheet, sht2 As Worksheet, sht3 As Worksheet
    Dim chk2 As Variant

    Set sht1 = ThisWorkbook.Worksheets("Sheet1") 'data to search in including condition
    Set sht2 = ThisWorkbook.Worksheets("Sheet2") 'data to search from
    Set sht3 = ThisWorkbook.Worksheets("Sheet3") 'output data

    chk2 = sht2.Range("A1", sht2.Cells(sht2.Rows.Count, "A").End(xlUp)).Value

    With sht1 ' reference "sheet1"
        With .Range("B1:A" & .Cells(sht1.Rows.Count, "A").End(xlUp).Row) 'reference referenced sheet columns A:B range from row 1 down to column A last not empty cell row
            .Rows(1).EntireRow.Insert ' insert a "helper" row for headers
            With .Offset(-1).Resize(.Rows.Count + 1) ' reference referenced range plus added header row
                .Rows(1).Value = Array("h1", "h2") ' write dummy headers
                .AutoFilter field:=1, Criteria1:=Application.Transpose(chk2), Operator:=xlFilterValues ' filter referened range on its first column with sheet2 column A values
                .Resize(.Rows.Count - 1, 1).Offset(1, 1).SpecialCells(xlCellTypeVisible).SpecialCells(XlCellType.xlCellTypeConstants).Offset(, -1).Copy Destination:=sht3.Range("A1") ' copy referenced range second column filtered cells (skipping headers) with some constant value and paste to sheet 3 from cell A1
                .Rows(1).Delete xlUp ' delete "helper" row
            End With
       End With
    End With

End Sub