|
- Sub test()
- Dim r%, i%
- Dim arr, brr
- Dim d As Object
- Set d = CreateObject("scripting.dictionary")
- With ThisWorkbook.Worksheets("水嫩冻干粉")
- r = .Cells(.Rows.Count, 2).End(xlUp).Row
- arr = .Range("a3:m" & r)
- End With
- s = 0
- For i = 1 To UBound(arr)
- If arr(i, 2) <> "水" Then
- If Not d.exists(arr(i, 2)) Then
- ReDim brr(1 To 4)
- brr(1) = m
- brr(2) = arr(i, 2)
- brr(3) = arr(i, 3)
- Else
- brr = d(arr(i, 2))
- End If
- brr(4) = brr(4) + arr(i, 6)
- s = s + arr(i, 6)
- d(arr(i, 2)) = brr
- End If
- Next
- ReDim crr(1 To d.Count, 1 To 4)
- m = 0
- For Each aa In d.keys
- m = m + 1
- brr = d(aa)
- brr(4) = brr(4) / s * 100
- For j = 1 To UBound(brr)
- crr(m, j) = brr(j)
- Next
- Next
- With ThisWorkbook.Worksheets("sheet1")
- .Cells.Clear
- .Columns(4).NumberFormatLocal = "0.000000000000000000000"
- With .Range("a1")
- .Value = "产品实际成分含量表"
- .Resize(1, 4).Merge
- With .Font
- .Name = "微软雅黑"
- .Size = 16
- End With
- End With
- With .Range("a2:d2")
- .Value = Array("序号", "标准中文名称", "INCI名", "实际成分含量(%)")
- .Borders.LineStyle = xlContinuous
- With .Font
- .Name = "微软雅黑"
- .Size = 12
- .Bold = True
- End With
- End With
- With .Range("a3").Resize(UBound(crr), UBound(crr, 2))
- .Value = crr
- .Borders.LineStyle = xlContinuous
- With .Font
- .Name = "微软雅黑"
- .Size = 12
- End With
- End With
- .Range("a3").Resize(UBound(crr), UBound(crr, 2)).Sort key1:=.Range("d2"), order1:=xlDescending, Header:=xlNo
- For i = 1 To UBound(crr)
- crr(i, 1) = i
- Next
- .Range("a3").Resize(UBound(crr), 1) = crr
- With .UsedRange
- .HorizontalAlignment = xlCenter
- .VerticalAlignment = xlCenter
- End With
- End With
- End Sub
复制代码 |
|