|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
参与一下。。。
- Sub ykcbf() '//2024.5.24
- Dim arr, brr, s
- Set d = CreateObject("Scripting.Dictionary")
- Set d1 = CreateObject("Scripting.Dictionary")
- Set sh = ThisWorkbook.Sheets("奖金发放汇总表")
- For Each sht In Sheets
- If Val(sht.Name) Then
- With sht
- r = .Cells(Rows.Count, 3).End(3).Row
- arr = .Range("a26:n" & r)
- For i = 1 To UBound(arr)
- If arr(i, 3) <> Empty Then
- s = arr(i, 1)
- d1(s) = ""
- s = .Name & "|" & arr(i, 1)
- d(s) = Application.WorksheetFunction.Round(arr(i, 13), 2)
- End If
- Next
- End With
- End If
- Next
- ReDim brr(1 To d.Count, 1 To 2)
- For Each k In d1.keys
- m = m + 1
- brr(m, 1) = m
- brr(m, 2) = k
- Next
- With sh
- .[a3].Resize(m, 2) = brr
- .UsedRange.Offset(3 + m).Clear
- arr = .[a1].Resize(m + 2, 15)
- For i = 3 To UBound(arr)
- For j = 2 To UBound(arr, 2) - 1
- s = arr(2, j) & "|" & arr(i, 2)
- If d.exists(s) Then
- .Cells(i, j) = d(s)
- End If
- Next
- .Cells(i, "o") = Application.WorksheetFunction.Sum(.Cells(i, 3).Resize(1, 12))
- Next
- .Cells(m + 3, 1) = "合计": .Cells(m + 3, 1).Resize(1, 2).Merge
- .Cells(m + 3, 3).Resize(1, 13).FormulaR1C1 = "=SUM(R3C:R" & "[-1]C)"
- ActiveWindow.DisplayZeros = False
- End With
- Set d = Nothing
- Set d1 = Nothing
- Application.ScreenUpdating = False
- MsgBox "OK!"
- End Sub
复制代码
|
评分
-
1
查看全部评分
-
|