|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Option Explicit
Sub TEST7()
Dim ar, br, cr$(), dr$(), i&, j&, k&, n&, dic As Object, iColSize&, t#
Application.ScreenUpdating = False
Set dic = CreateObject("Scripting.Dictionary")
t = Timer
ar = Sheets(1).Range("O2", Sheets(1).Cells(Rows.Count, "O").End(xlUp)).Value
br = Sheets(2).[A1].CurrentRegion.Value
For i = 2 To UBound(br)
dic(br(i, 1)) = br(i, 2)
Next i
ReDim br(1 To UBound(ar), 1 To 20)
For i = 1 To UBound(ar)
n = 0
cr = Split(ar(i, 1), ";")
If (UBound(cr) + 1) * 2 > iColSize Then iColSize = (UBound(cr) + 1) * 2
For j = 0 To UBound(cr)
dr = Split(cr(j), " * ")
n = n + 1
br(i, n) = dr(0)
If Not dic.exists(dr(0)) Then
n = n + 1
br(i, n) = Empty
Else
n = n + 1
br(i, n) = dic(dr(0)) * dr(1)
End If
Next j
Next i
With Sheets(3)
.Cells.Clear
With .[A1].Resize(UBound(br), iColSize)
.Value = br
.HorizontalAlignment = xlCenter
.Borders.LineStyle = xlContinuous
.EntireColumn.AutoFit
End With
.Activate
End With
Set dic = Nothing
Application.ScreenUpdating = True
MsgBox "执行完毕!_用时: " & Format(Timer - t, "0.00") & " 秒", 64
End Sub
|
评分
-
1
查看全部评分
-
|