|
参与一下。。。
- Sub ykcbf() '//2024.12.16
- Application.ScreenUpdating = False
- Set d = CreateObject("Scripting.Dictionary")
- With Sheets("对照库添加")
- r = .Cells(Rows.Count, 1).End(3).Row
- c = .UsedRange.Columns.Count
- arr = .[a1].Resize(r, c)
- .UsedRange.Offset(1).ClearContents
- End With
- With Sheets("对照信息")
- r = .Cells(Rows.Count, 1).End(3).Row
- c = .UsedRange.Columns.Count
- zrr = .[a1].Resize(r, c)
- For j = 1 To UBound(zrr, 2)
- s = zrr(1, j)
- d(s) = j
- Next
- ReDim brr(1 To 1000, 1 To c)
- For i = 2 To UBound(arr)
- If arr(i, 1) <> Empty Then
- m = m + 1
- For j = 1 To UBound(arr, 2)
- If InStr(arr(1, j), "(") Then
- l = InStr(arr(1, j), "(")
- s = Left(arr(1, j), l - 1)
- Else
- s = arr(1, j)
- End If
- If d.exists(s) Then
- brr(m, d(s)) = arr(i, j)
- End If
- Next
- End If
- Next
- .Cells(r + 1, 1).Resize(m, c) = brr
- End With
- Set d = Nothing
- Application.ScreenUpdating = False
- MsgBox "OK!"
- End Sub
复制代码
|
评分
-
1
查看全部评分
-
|