|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub 按钮1_Click()
Set d = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
arr = Sheets("BaseB").[a2].Resize(400000, 9)
For j = 1 To UBound(arr)
If Len(arr(j, 1)) > 0 Then
d(arr(j, 1)) = j
Else
r = j - 1
Exit For
End If
Next j
For i = 2 To 4
brr = Sheets(i).UsedRange
For j = 2 To UBound(brr)
If Len(brr(j, 1)) > 0 Then
If Not d.exists(brr(j, 1)) Then
r = r + 1
arr(r, 1) = brr(j, 1)
d(brr(j, 1)) = r
End If
arr(d(brr(j, 1)), i * 2) = brr(j, 2)
arr(d(brr(j, 1)), i * 2 + 1) = brr(j, 3)
End If
Next j
Next i
Sheets("Total").UsedRange.Offset(2).ClearContents
Sheets("Total").[a3].Resize(r, UBound(arr, 2)) = arr
Application.ScreenUpdating = True
End Sub
|
|