谁能给我解释一下这段代码的意思呢? 35
Dimi&,Myr&,Arr,Arr1(),r%Dimd,k,j&,ii&,m&,n&,xSetd=CreateObject("Scripting.Dictionary"...
Dim i&, Myr&, Arr, Arr1(), r%
Dim d, k, j&, ii&, m&, n&, x
Set d = CreateObject("Scripting.Dictionary")
Myr = Sheet2.[a65536].End(xlUp).Row
Arr = Sheet2.Range("a5:g" & Myr)
For i = 1 To UBound(Arr)
x = Arr(i, 3)
d(x) = ""
Next
k = d.keys
m = 1
For j = 0 To UBound(k)
For i = 1 To UBound(Arr)
If Arr(i, 3) = k(j) Then
r = r + 1
ReDim Preserve Arr1(1 To r)
Arr1(r) = i
n = n + 1
If n > 2 Then
r = r + 1
ReDim Preserve Arr1(1 To r)
Arr1(r) = i
End If
End If
Next
If r > 1 Then
For ii = 1 To r
m = m + 1
Sheet3.Cells(m, 2).Resize(1, 7) = Application.Index(Arr, Arr1(ii), 0)
Next
End If
n = 0: r = 0
Erase Arr1
Next
End Sub 展开
Dim d, k, j&, ii&, m&, n&, x
Set d = CreateObject("Scripting.Dictionary")
Myr = Sheet2.[a65536].End(xlUp).Row
Arr = Sheet2.Range("a5:g" & Myr)
For i = 1 To UBound(Arr)
x = Arr(i, 3)
d(x) = ""
Next
k = d.keys
m = 1
For j = 0 To UBound(k)
For i = 1 To UBound(Arr)
If Arr(i, 3) = k(j) Then
r = r + 1
ReDim Preserve Arr1(1 To r)
Arr1(r) = i
n = n + 1
If n > 2 Then
r = r + 1
ReDim Preserve Arr1(1 To r)
Arr1(r) = i
End If
End If
Next
If r > 1 Then
For ii = 1 To r
m = m + 1
Sheet3.Cells(m, 2).Resize(1, 7) = Application.Index(Arr, Arr1(ii), 0)
Next
End If
n = 0: r = 0
Erase Arr1
Next
End Sub 展开
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询