Question

有一段VBA代码，有A、B两列，求B列数据在A列中第一个相同数据的行号并填入C列对应B列的行中，代码如下：

Sub 查找()
Dim I, J, rA, rB As Long
rA = Cells(65536, 1).End(xlUp).Row
rB = Cells(65536, 2).End(xlUp).Row
For I = 1 To rB
For J = 1 To rA
If Cells(I, 2) = Cells(J, 1) Then
Cells(I, 3) = J
J = rA
End If
Next J
Next I
End Sub
以上代码测试无误，由于行数太多，循环运算太慢，请帮忙改一下，定义一个变量存储运算结果，然后一次性填入C列中如何。

Answer 1

我觉得是你循环嵌套的缘故.
试试这样

Sub 查找()
Dim i, a, b, rb As Long
rb = Cells(65536, 2).End(xlUp).Row
ReDim a(1 To rb, 1 To 1)
For i = 1 To rb
Set b = Range("a:a").Find(Cells(i, 2), Range("a65536"), , xlWhole)
If Not b Is Nothing Then a(i, 1) = b.Row
Next
Cells(1, 3).Resize(rb, 1) = a
End Sub

Answer 2

用数组进行循环处理，速度会大幅度提高！

Sub 查找()
Dim I, J, rA, rB, rC
rA = Range("A1:A" & Range("A65536").End(xlUp).Row)
rB = Range("B1:B" & Range("B65536").End(xlUp).Row)
If UBound(rA) > UBound(rB) Then
ReDim rC(1 To UBound(rA))
Else
ReDim rC(1 To UBound(rB))
End If

For I = 1 To UBound(rB)
For J = 1 To UBound(rA)
If rA(J, 1) = rB(I, 1) Then rC(I) = J: Exit For
Next J
Next I
Range("C1").Resize(UBound(rC)) = WorksheetFunction.Transpose(rC)
End Sub

Answer 3

For I = 1 To rB
For J = 1 To rA
If Cells(I, 2) = Cells(J, 1) Then
Cells(I, 3) = J
J = rA
exit for '找到后就退出j循环，不需要完成整个循环，继续下一个i。加上这句最简单。
End If
Next J
Next I

Answer 4

不用宏的解决办法：
在C1输入公式
=IF(ISERROR(MATCH(A1,B:B,0)),"",MATCH(A1,B:B,0))
向下复制公式。