有一段VBA代码,有A、B两列,求B列数据在A列中第一个相同数据的行号并填入C列对应B列的行中,代码如下:
Sub查找()DimI,J,rA,rBAsLongrA=Cells(65536,1).End(xlUp).RowrB=Cells(65536,2).End(xlUp).R...
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列中如何。 展开
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列中如何。 展开
4个回答
展开全部
我觉得是你循环嵌套的缘故.
试试这样
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
试试这样
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
展开全部
用数组进行循环处理,速度会大幅度提高!
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
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
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
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
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
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
展开全部
不用宏的解决办法:
在C1输入公式
=IF(ISERROR(MATCH(A1,B:B,0)),"",MATCH(A1,B:B,0))
向下复制公式。
在C1输入公式
=IF(ISERROR(MATCH(A1,B:B,0)),"",MATCH(A1,B:B,0))
向下复制公式。
已赞过
已踩过<
评论
收起
你对这个回答的评价是?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询