sheet1的A列为名称。根据sheet2的一个三维数组，找出各名称对应的序号和分类号，并存储到sheet1的B列和C列中。代码如下：Sub name()
'定义数组并赋值
Dim arr
arr = Worksheets("sheet2").Range("a2:c96")
'遍历每个单元格
Worksheets("sheet1").Activate
Dim i As Integer, Y As Integer, str1 As String, str2 As String
i = 1
While Range("A" & i) <> ""
For Y = 1 To 95
str1 = arr(Y, 2) & ","
str2 = arr(Y, 3)
Do While Range("A" & i) = str
Range("B" & i) = Y
Range("C" & i) = arr(Y, 3)
Loop
Next
i = i + 1
Wend
End Sub
但是每次运行都会死机。
然后我改了代码，直接比较单元格。代码如下：
Sub countyno()
Dim i As Integer, j As Integer, str1 As String, str2 As String
i = 2
While Worksheets("sheet1").Range("A" & i) <> ""
For j = 2 To 96
Do While Worksheets("sheet1").Range("A" & i) = Worksheets("sheet2").Range("B" & j)
Worksheets("sheet1").Range("B" & i) = Worksheets("sheet2").Range("A" & j)
Worksheets("sheet1").Range("C" & i) = Worksheets("sheet2").Range("C" & j)
Loop
Next
i = i + 1
Wend
End Sub
还是会死机。
还请高手指教。是不是数据太大了。万分感谢！作者: pureshadow 时间: 2009-2-20 09:20
原来是进入死循环了……
楼主可以试试按F8逐行运行代码的办法，并且把本地窗口打开，查看变量的运行，就可以明白是怎么回事了。作者: qiaonation 时间: 2009-2-20 09:39 2#pureshadow
问题已经解决，来自OFFICE精英俱乐部，wxyqxxz2007
Sub pipei()
Set d = CreateObject("scripting.dictionary")
With Sheets("sheet2")
r = .Range("a65536").End(xlUp).Row
ar = .Range("a2:c" & r)
End With
For i = 1 To UBound(ar)
If Not d.exists(ar(i, 2)) Then d(ar(i, 2)) = ar(i, 1) & "//" & ar(i, 3)
Next
With Sheets("sheet1")
r = .Range("a65536").End(xlUp).Row
ar = .Range("a2:c" & r)
For i = 1 To UBound(ar)
If d.exists(ar(i, 1)) Then
ar(i, 2) = Split(d(ar(i, 1)), "//")(0)
ar(i, 3) = Split(d(ar(i, 1)), "//")(1)
End If
Next
.Range("b2").Resize(UBound(ar)) = Application.Index(ar, 0, 2)
.Range("c2").Resize(UBound(ar)) = Application.Index(ar, 0, 3)
End With
End Sub