|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
- Sub 汇总()
- Dim i As Long, j As Long '循环变量
- Dim m As Integer, n As Integer, p As Integer '定位变量
- Dim S As Double, Nums As Long '面积、数量
- Dim Sht As Worksheet, d As Object, Re As Object, Mat As Object, Mats As Object
- Dim Data, Result()
- Set Sht = Sheets("汇总")
- Set Re = CreateObject("vbscript.regexp")
- Set d = CreateObject("scripting.dictionary")
- Data = Sht.Range("A1").CurrentRegion
- For i = 2 To UBound(Data)
- S = 0: Nums = 0
- If Not d.exists(Data(i, 1)) Then
- n = n + 1
- d(Data(i, 1)) = n
- ReDim Preserve Result(1 To 3, 1 To n)
- Result(1, n) = Data(i, 1)
- m = n
- Else
- m = d(Data(i, 1))
- End If
- With Re
- .Global = True
- .Pattern = "[\d\*]+"
- Set Mats = .Execute(Data(i, 2))
- For Each Mat In Mats
- S = S + Evaluate(Mat.Value) / 1000000
- p = InStrRev(Mat.Value, "*")
- Nums = Nums + Right(Mat.Value, Len(Mat.Value) - p)
- Next Mat
- End With
- Result(2, m) = Result(2, m) + Nums
- Result(3, m) = Result(3, m) + S
- Next i
- Range("A2").Resize(n, 3) = Application.Transpose(Result)
- End Sub
复制代码 |
|