|
Sub gonghuoshang()
Dim arr As Variant
Dim brr As Variant
Dim crr As Variant
Dim wb As Workbook
Dim wb1 As Workbook
t = Timer
s = "供货商.xlsx"
m = "C:\Users\admin021\Desktop" \ "+ s"
Set wb = Workbooks.Open(m)
Set shb = wb.Sheets(1)
k = shb.Range("a1000000").End(xlUp).Row
arr = shb.Range("a1:b" & k)
For i = k To 2 Step -1
If shb.Range("a" & i) = "" Then
shb.Range("a" & i).EntireRow.Delete
End If
Next
k = shb.Range("a1000000").End(xlUp).Row
arr = shb.Range("a1:b" & k)
For i = 1 To k
arr(i, 1) = Trim(arr(i, 1))
arr(i, 1) = Replace(arr(i, 1), Chr(10), "")
Next
shb.Range("a1").Resize(k, 2) = arr
With ActiveWorkbook.Sheets(1)
Set d = CreateObject("scripting.dictionary")
r = .Cells(Rows.Count, 1).End(xlUp).Row
ar = .Range("a1:b" & r)
For i = 2 To UBound(ar)
If Trim(ar(i, 1)) <> "" Then
If Not d.exists(Trim(ar(i, 1))) Then
d(Trim(ar(i, 1))) = ar(i, 2)
Else
d(Trim(ar(i, 1))) = d(Trim(ar(i, 1))) & "," & ar(i, 2)
End If
End If
Next i
rs = .Cells(Rows.Count, 5).End(xlUp).Row + 2
.Range("e2:f" & rs) = Empty
.[e2].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
End With
End Sub
但是在旧版就能使用,请问是什么原因
|
|