|
今回は 集計後の行数がほぼ分かっているので、
あらかじめ十分な行数をもった配列を確保しておけば、
ワークシート関数のTRANSPOSEも 自前Transpose 関数作る必要なく
行けます。
Sub 集計_12か月分TR()
Dim myDic As Object, c As Range
Dim myID, myName, v課税所得, v社保控除, v源泉徴収
Dim i As Long, k As Long, n As Long
' ---元データを配列に格納
With Sheets("支給台帳")
With .Range("C:C")
Set c = Excel.Range(.Item(2), .Item(.Count).End(xlUp))
End With
myID = c.Value
myName = c.Offset(, 1).Value
v課税所得 = Intersect(c.EntireRow, .Columns("CN")).Value
v社保控除 = Intersect(c.EntireRow, .Columns("BZ")).Value
v源泉徴収 = Intersect(c.EntireRow, .Columns("CO")).Value
End With
' ---社員ID別金額集計
ReDim vout(1000, 1 To 5)
vout(0, 1) = "ID"
vout(0, 2) = "氏名"
vout(0, 3) = "課税所得額"
vout(0, 4) = "社会保険控除額"
vout(0, 5) = "源泉徴収税額"
Set myDic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(myID)
If Not myID(i, 1) = Empty Then
n = myDic(myID(i, 1))
If n = 0 Then
'---C列のIDがまだmyDicになければ、 _
出力行カウンタkを更新して IDとkをセットで登録
k = k + 1
myDic(myID(i, 1)) = k
n = k
vout(n, 1) = myID(i, 1)
vout(n, 2) = myName(i, 1)
End If
vout(n, 3) = vout(n, 3) + v課税所得(i, 1)
vout(n, 4) = vout(n, 4) + v社保控除(i, 1)
vout(n, 5) = vout(n, 5) + v源泉徴収(i, 1)
End If
Next
Set myDic = Nothing
' --- 集計結果配列voutのシートへの書き出し
With Worksheets("年調データ")
.UsedRange.ClearContents
.Range("A1").Resize(k + 1, 5).Value = vout
End With
MsgBox "集計しました"
End Sub
|
|