[已解决]VBA批量查询功能

hackcan

请各位老师帮忙给解决一个问题，谢谢了

我有一个子、母件的对应表，有时要查找某个母件对应什么子件，查找一下也很方便，但是有时要查找很多母件，一个个的查找起来很麻烦，所以请请教各位，能不能用VBA实现将所有要查询的一次性全显示出来

最佳答案

月排行榜 / 总排行榜

zjdh

2013-9-20 07:57

可修改为：
Sub TEST()
    Range("B2:W65500").ClearContents
    ARR = Sheets(1).Range("A2:A" & Sheets(1).Range("A65536").End(3).Row)
    BRR = Sheets(2).Range("A2:A" & Sheets(2).Range("A65536").End(3).Row)
    If IsArray(ARR) Then
        For I = 1 To UBound(ARR)
            For J = 1 To UBound(BRR)
                If ARR(I, 1) = BRR(J, 1) Then
                    AD = Sheets(1).Cells(I + 1, 255).End(1)(1, 2).Address
                    Sheets(2).Range("B" & J + 1 & ":C" & J + 1).Copy Sheets(1).Range(AD)
                End If
            Next
        Next
    Else
        For J = 1 To UBound(BRR)
            If ARR = BRR(J, 1) Then
                AD = Sheets(1).Cells(2, 255).End(1)(1, 2).Address
                Sheets(2).Range("B" & J + 1 & ":C" & J + 1).Copy Sheets(1).Range(AD)
            End If
        Next
    End If
End Sub

跳转到最佳答案楼层

zjdh

示例.rar (16.05 KB, 下载次数: 69)

2013-9-18 16:09 上传

点击文件名下载附件

hackcan

zjdh 发表于 2013-9-18 15:58

Sub TEST()
    Range("B2:W65500").ClearContents
    ARR = Sheets(1).Range("A2:A" & Sheets(1).Range("A65536").End(3).Row)
    BRR = Sheets(2).Range("A2:A" & Sheets(2).Range("A65536").End(3).Row)
    For i = 1 To UBound(ARR)
        For j = 1 To UBound(BRR)
            If ARR(i, 1) = BRR(j, 1) Then
               AD = Sheets(1).Cells(i + 1, 255).End(1)(1, 2).Address
                Sheets(2).Range("B" & j + 1 & ":C" & j + 1).Copy Sheets(1).Range(AD)
            End If
        Next
    Next
End Sub


请问大神，为什么我查询某一个时提示    类型不匹配

zjdh

hackcan 发表于 2013-9-18 16:57
Sub TEST()
    Range("B2:W65500").ClearContents
    ARR = Sheets(1).Range("A2:A" & Sheets(1).Ran ...

那是因为只有一个时，ARR就不是数组啦！

zjdh

可修改为：
Sub TEST()
    Range("B2:W65500").ClearContents
    ARR = Sheets(1).Range("A2:A" & Sheets(1).Range("A65536").End(3).Row)
    BRR = Sheets(2).Range("A2:A" & Sheets(2).Range("A65536").End(3).Row)
    If IsArray(ARR) Then
        For I = 1 To UBound(ARR)
            For J = 1 To UBound(BRR)
                If ARR(I, 1) = BRR(J, 1) Then
                    AD = Sheets(1).Cells(I + 1, 255).End(1)(1, 2).Address
                    Sheets(2).Range("B" & J + 1 & ":C" & J + 1).Copy Sheets(1).Range(AD)
                End If
            Next
        Next
    Else
        For J = 1 To UBound(BRR)
            If ARR = BRR(J, 1) Then
                AD = Sheets(1).Cells(2, 255).End(1)(1, 2).Address
                Sheets(2).Range("B" & J + 1 & ":C" & J + 1).Copy Sheets(1).Range(AD)
            End If
        Next
    End If
End Sub

zjdh

可修改为：
Sub TEST()
    Range("B2:W65500").ClearContents
    ARR = Sheets(1).Range("A2:A" & Sheets(1).Range("A65536").End(3).Row)
    BRR = Sheets(2).Range("A2:A" & Sheets(2).Range("A65536").End(3).Row)
    If IsArray(ARR) Then
        For I = 1 To UBound(ARR)
            For J = 1 To UBound(BRR)
                If ARR(I, 1) = BRR(J, 1) Then
                    AD = Sheets(1).Cells(I + 1, 255).End(1)(1, 2).Address
                    Sheets(2).Range("B" & J + 1 & ":C" & J + 1).Copy Sheets(1).Range(AD)
                End If
            Next
        Next
    Else
        For J = 1 To UBound(BRR)
            If ARR = BRR(J, 1) Then
                AD = Sheets(1).Cells(2, 255).End(1)(1, 2).Address
                Sheets(2).Range("B" & J + 1 & ":C" & J + 1).Copy Sheets(1).Range(AD)
            End If
        Next
    End If
End Sub

hackcan

zjdh 发表于 2013-9-20 07:57
可修改为：
Sub TEST()
    Range("B2:W65500").ClearContents

先谢谢大哥了，等下去试试！