|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub 计算()
Dim i, m, n, st, gs, mm As Integer
Dim k, s, t, ss
Dim ar, br, cr As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
ar = Sheets("原始表").[g1].CurrentRegion
For i = 2 To UBound(ar)
d(ar(i, 1)) = ar(i, 2)
s = WorksheetFunction.Substitute(ar(i, 1), "厘米", "")
t = WorksheetFunction.Substitute(ar(i, 1), "厘米", "cm")
d(s) = ar(i, 2)
d(t) = ar(i, 2)
Next
br = Sheets("原始表").[a1].CurrentRegion
ReDim cr(1 To UBound(br) - 1, 1 To 1)
For Each k In d.keys
For i = 2 To UBound(br)
gs = Len(br(i, 2)) - Len(WorksheetFunction.Substitute(br(i, 2), ";", ""))
If gs = 1 Then
m = WorksheetFunction.Find("[", br(i, 2))
n = WorksheetFunction.Find("]", br(i, 2))
st = Val(Mid(br(i, 2), m + 1, n - m - 1))
If InStr(br(i, 2), k) > 1 Then
cr(i - 1, 1) = cr(i - 1, 1) + d(k) * st
Else
cr(i - 1, 1) = cr(i - 1, 1) + 0
End If
Else
For mm = 1 To gs
ss = Split(br(i, 2), ";")(mm - 1)
m = WorksheetFunction.Find("[", ss)
n = WorksheetFunction.Find("]", ss)
st = Val(Mid(ss, m + 1, n - m - 1))
If InStr(ss, k) > 1 Then
cr(i - 1, 1) = cr(i - 1, 1) + d(k) * st
Else
cr(i - 1, 1) = cr(i - 1, 1) + 0
End If
Next
End If
Next
Next
Sheets("原始表").[c2].Resize(50000, 1).ClearContents
Sheets("原始表").[c2].Resize(UBound(br) - 1, 1) = cr
MsgBox "ok"
End Sub
|
评分
-
1
查看全部评分
-
|