Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

14711 / 76734

←次へ　｜　前へ→


	【67512】Re:Dictionaryについて

kanabun - 10/12/9(木) 19:11 -


	引用なし

	パスワード

今回は集計後の行数がほぼ分かっているので、
あらかじめ十分な行数をもった配列を確保しておけば、
ワークシート関数の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

0 hits

▼

【67485】Dictionaryについて 八家九僧陀 10/12/9(木) 1:45