Excel VBA質問箱 IV

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

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


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

2512 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

▼

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

【67487】Re:Dictionaryについて Hirofumi 10/12/9(木) 8:33

【67490】Re:Dictionaryについて Hirofumi 10/12/9(木) 9:29

【67505】Re:Dictionaryについて Hirofumi 10/12/9(木) 18:05

【67507】Re:Dictionaryについて 八家九僧陀 10/12/9(木) 18:15

【67511】Re:Dictionaryについて Hirofumi 10/12/9(木) 19:03

【67575】Re:Dictionaryについて 八家九僧陀 10/12/15(水) 0:48

【67492】Re:Dictionaryについて kanabun 10/12/9(木) 10:00

【67500】Re:Dictionaryについて kanabun 10/12/9(木) 16:12

【67506】Re:Dictionaryについて Hirofumi 10/12/9(木) 18:06

【67508】Re:Dictionaryについて 八家九僧陀 10/12/9(木) 18:22

【67510】Re:Dictionaryについて kanabun 10/12/9(木) 18:46

【67512】Re:Dictionaryについて kanabun 10/12/9(木) 19:11

【67576】Re:Dictionaryについて 八家九僧陀 10/12/15(水) 0:57

【67577】Re:Dictionaryについて kanabun 10/12/15(水) 9:25

【67582】Re:Dictionaryについて 八家九僧陀 10/12/15(水) 22:30

【67493】Re:Dictionaryについて UO3 10/12/9(木) 10:21

【67494】Re:Dictionaryについて kanabun 10/12/9(木) 11:19

【67496】Re:Dictionaryについて UO3 10/12/9(木) 14:18

【67499】Re:Dictionaryについて kanabun 10/12/9(木) 16:06

【67509】Re:Dictionaryについて 八家九僧陀 10/12/9(木) 18:31


	【67485】Dictionaryについて

八家九僧陀 - 10/12/9(木) 1:45 -


	引用なし

	パスワード

年末調整事務をしています。
１年間の課税所得額、社会保険料控除額、源泉徴収税額をDictinaryを利用して集計をしようとネットで調べて、あるサイトでDictionaryを使って「重複しない品名と個数の合計を計算します」というものを見つけたのですが、なにせ初心者、読解力なしの私には難解で、すぐに活用できそうにありません。
自分のデータ表に合うようなコードを教えてください。

１年12ヶ月分の各個人の給与支給データ（A列～CR列、毎月約８０名×12=約1,000行ほどのデータ量）が格納されたシート”支給台帳”（A列～CR列）のうち、C列＝社員IDを元に、その社員IDに対応したD列＝氏名を抽出すると同時に、CN列＝課税所得額、BZ列＝社会保険控除額、CO列＝源泉徴収税額の３項目の合計額の結果を、シート”年調データ”のA列に社員ID、B列に氏名、C列に課税所得額、D列に社会保険控除額、E列に源泉徴収税額の各集計結果を抽出させたいのですが、ご教示いただけませんか？
折角しらべたのだから、下のコードでいろいろ試せばいいのでしょうが、いかんせん、実稼動させる期限がせまり余裕がなくあせっています。
丸投げで申し訳ありませんが、ご教示ください。

'///以下は調べたサイトのコードです。
Sub rei21_2()
　Dim myDic As Object, myKey, myItem
　Dim myVal
　Dim i As Long
　　Set myDic = CreateObject("Scripting.Dictionary")
　　Range("D2", Range("E" & Rows.Count).End(xlUp)).ClearContents
　　Range("D1:E1").Value = Range("A1:B1").Value
　　' ---元データを配列に格納
　　myVal = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
　　' ---myDicへデータを格納
　　　　For i = 1 To UBound(myVal, 1)
　　　　　　If Not myVal(i, 1) = Empty Then
　　　　　　　　If Not myDic.exists(myVal(i, 1)) Then
　　　　　　　　　　'---新たなkeyの時はkeyとitemを追加します
　　　　　　　　　　myDic.Add myVal(i, 1), myVal(i, 2)
　　　　　　　　Else
　　　　　　　　　　'---すでに存在しているkeyの時はitemを加算します
　　　　　　　　　　myDic(myVal(i, 1)) = myDic(myVal(i, 1)) + myVal(i, 2)
　　　　　　　　End If
　　　　　　End If
　　　　Next
　　' ---Key,Itemの書き出し
　　myKey = myDic.keys
　　myItem = myDic.items
　　　　For i = 0 To UBound(myKey)
　　　　　　Cells(i + 2, 4).Value = myKey(i)
　　　　　　Cells(i + 2, 5).Value = myItem(i)
　　　　Next
　　Set myDic = Nothing
End Sub


	【67487】Re:Dictionaryについて

Hirofumi - 10/12/9(木) 8:33 -


	引用なし

	パスワード

1000行位なら、Dictionaryを使わなくても善いかも？
社員IDをKeyとしてListを整列
上から、社員IDを見て行って、同じ間は集計、違ったら出力を繰り返します

Option Explicit

Public Sub Sample_1()

　　'"支給台帳"のデータ列数（A列～CR列）
　　Const clngColumns As Long = 96
　　'"社員ID"の有る列(C列のA列からの列Offset A列を0列として勘定する)
　　Const clngGroup As Long = 2
　　
　　Dim i As Long
　　Dim j As Long
　　Dim lngRows As Long
　　Dim rngList As Range
　　Dim rngResult As Range
　　Dim vntPost As Variant
　　Dim vntData() As Variant
　　Dim vntResult() As Variant
　　Dim lngWrite As Long
　　Dim strProm As String

　　'"支給台帳"の先頭セル位置を基準とする（先頭列の列見出しのセル位置）
　　Set rngList = Worksheets("支給台帳").Range("A1")

　　'"年調データ"の先頭セル位置を基準とする（先頭列の列見出しのセル位置）
　　Set rngResult = Worksheets("年調データ").Range("A1")
　　
　　'"支給台帳"の社員ID、氏名、課税所得額、社会保険控除額、源泉徴収税額の
　　'列位置をA列を1列として、列挙する
　　vntPost = Array(3, 4, 78, 92, 93)
　　
　　'画面更新を停止
　　Application.ScreenUpdating = False
　　
　　'"年調データ"に就いて
　　With rngResult
　　　　'行数の取得
　　　　lngRows = .Offset(Rows.Count - .Row, clngGroup).End(xlUp).Row - .Row
　　　　'データが有ればクリア
　　　　If lngRows > 0 Then
　　　　　　.Offset(1).Resize(lngRows, UBound(vntPost) + 1).ClearContents
　　　　End If
　　End With
　　
　　'"支給台帳"に就いて
　　With rngList
　　　　'行数の取得
　　　　lngRows = .Offset(Rows.Count - .Row, clngGroup).End(xlUp).Row - .Row
　　　　If lngRows <= 0 Then
　　　　　　strProm = "データが有りません"
　　　　　　GoTo Wayout
　　　　End If
　　　　'社員ID列で整列
　　　　.Offset(1).Resize(lngRows, clngColumns).Sort _
　　　　　　　　Key1:=.Offset(, clngGroup), Order1:=xlAscending, _
　　　　　　　　Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
　　　　　　　　Orientation:=xlTopToBottom, SortMethod:=xlStroke
　　End With
　　
　　'出力用配列を確保
　　ReDim vntResult(UBound(vntPost))
　　
　　'"支給台帳"の先頭行を配列として取得
　　vntData = rngList.Offset(1).Resize(, clngColumns).Value
　　'出力用配列に転記
　　For i = 0 To UBound(vntPost)
　　　　vntResult(i) = vntData(1, vntPost(i))
　　Next i
　　'2行目～最終行+1まで繰り返し（最終データの下の行をダミーデータとします）
　　For i = 2 To lngRows + 1
　　　　'"支給台帳"の1行分を配列として取得
　　　　vntData = rngList.Offset(i).Resize(, clngColumns).Value
　　　　'社員IDが違った場合
　　　　If vntResult(0) <> vntData(1, clngGroup + 1) Then
　　　　　　'結果を出力（社員ID一人分）
　　　　　　lngWrite = lngWrite + 1
　　　　　　rngResult.Offset(lngWrite).Resize(, UBound(vntPost) + 1) = vntResult
　　　　　　'出力用配列に転記
　　　　　　For j = 0 To UBound(vntPost)
　　　　　　　　vntResult(j) = vntData(1, vntPost(j))
　　　　　　Next j
　　　　Else
　　　　　　'出力用配列に課税所得額、社会保険控除額、源泉徴収税額を加算
　　　　　　For j = 2 To UBound(vntPost)
　　　　　　　　vntResult(j) = vntResult(j) + vntData(1, vntPost(j))
　　　　　　Next j
　　　　End If
　　Next i
　　　
　　strProm = "処理が完了しました"
　　　
Wayout:

　　'画面更新を再開
　　Application.ScreenUpdating = True
　　　
　　Set rngList = Nothing
　　Set rngResult = Nothing
　　　
　　MsgBox strProm, vbInformation
　　　　　
End Sub


	【67490】Re:Dictionaryについて

Hirofumi - 10/12/9(木) 9:29 -


	引用なし

	パスワード

Dictionaryだとこんなかな？

Option Explicit

Public Sub Sample_2()

　　'"支給台帳"のデータ列数（A列～CR列）
　　Const clngColumns As Long = 96
　　'"社員ID"の有る列(C列のA列からの列Offset A列を0列として勘定する)
　　Const clngGroup As Long = 2
　　
　　Dim i As Long
　　Dim j As Long
　　Dim k As Long
　　Dim lngRows As Long
　　Dim rngList As Range
　　Dim rngResult As Range
　　Dim vntPost As Variant
　　Dim vntData() As Variant
　　Dim vntResult() As Variant
　　Dim vntPos As Variant
　　Dim dicIndex As Object
　　Dim strProm As String

　　'"支給台帳"の先頭セル位置を基準とする（先頭列の列見出しのセル位置）
　　Set rngList = Worksheets("支給台帳").Range("A1")

　　'"年調データ"の先頭セル位置を基準とする（先頭列の列見出しのセル位置）
　　Set rngResult = Worksheets("年調データ").Range("A1")
　　　　
　　'"支給台帳"の社員ID、氏名、課税所得額、社会保険控除額、源泉徴収税額の
　　'列位置をA列を1列として、列挙する
　　vntPost = Array(3, 4, 78, 92, 93)
　　
　　'Dictionaryオブジェクトを取得
　　Set dicIndex = CreateObject("Scripting.Dictionary")
　　
　　'"年調データ"に就いて
　　With rngResult
　　　　'行数の取得
　　　　lngRows = .Offset(Rows.Count - .Row, clngGroup).End(xlUp).Row - .Row
　　　　'データが有ればクリア
　　　　If lngRows > 0 Then
　　　　　　.Offset(1).Resize(lngRows, UBound(vntPost) + 1).ClearContents
　　　　End If
　　End With
　　
　　'"支給台帳"に就いて
　　With rngList
　　　　'行数の取得
　　　　lngRows = .Offset(Rows.Count - .Row, clngGroup).End(xlUp).Row - .Row
　　　　If lngRows <= 0 Then
　　　　　　strProm = "データが有りません"
　　　　　　GoTo Wayout
　　　　End If
　　End With
　　
　　'出力用配列を確保（12か月分）
　　ReDim vntResult(1 To -Int(-lngRows / 12), UBound(vntPost))
　　
　　'1行目～最終行まで繰り返し
　　For i = 1 To lngRows
　　　　'"支給台帳"の1行分を配列として取得
　　　　vntData = rngList.Offset(i).Resize(, clngColumns).Value
　　　　vntPos = dicIndex.Item(CStr(vntData(1, clngGroup + 1)))
　　　　'社員IDが違った場合
　　　　If Not IsEmpty(vntPos) Then
　　　　　　'出力用配列に課税所得額、社会保険控除額、源泉徴収税額を加算
　　　　　　For j = 2 To UBound(vntPost)
　　　　　　　　vntResult(vntPos, j) = vntResult(vntPos, j) + vntData(1, vntPost(j))
　　　　　　Next j
　　　　Else
　　　　　　k = k + 1
　　　　　　dicIndex.Item(CStr(vntData(1, clngGroup + 1))) = k
　　　　　　'出力用配列に転記
　　　　　　For j = 0 To UBound(vntPost)
　　　　　　　　vntResult(k, j) = vntData(1, vntPost(j))
　　　　　　Next j
　　　　End If
　　Next i
　　
　　'結果を出力
　　rngResult.Offset(1).Resize(k, UBound(vntPost) + 1).Value = vntResult
　　
　　strProm = "処理が完了しました"
　　　
Wayout:

　　Set dicIndex = Nothing
　　Set rngList = Nothing
　　Set rngResult = Nothing
　　　
　　MsgBox strProm, vbInformation
　　　　　
End Sub


	【67492】Re:Dictionaryについて

kanabun - 10/12/9(木) 10:00 -


	引用なし

	パスワード

▼八家九僧陀さん：

> ネットで調べて、あるサイトでDictionaryを使って

すでに Hirofumiさんから Dictionary使ったサンプルが出ていますが、
ぼくもせっかく書いたのでアップしておきます

Sub 集計_12か月分()
　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(1 To 5, 2000)
　　vout(1, 0) = "ID"
　　vout(2, 0) = "氏名"
　　vout(3, 0) = "課税所得額"
　　vout(4, 0) = "社会保険控除額"
　　vout(5, 0) = "源泉徴収税額"
　　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(1, n) = myID(i, 1)
　　　　　　　　vout(2, n) = myName(i, 1)
　　　　　　End If
　　　　　　vout(3, n) = vout(3, n) + v課税所得(i, 1)
　　　　　　vout(4, n) = vout(4, n) + v社保控除(i, 1)
　　　　　　vout(5, n) = vout(5, n) + v源泉徴収(i, 1)
　　　　End If
　　Next
　　Set myDic = Nothing
　　
　　' --- 集計結果配列voutのシートへの書き出し
　　With Worksheets("年調データ")
　　　　.UsedRange.ClearContents
　　　　.Range("A1").Resize(k + 1, 5).Value = Application.Transpose(vout)
　　End With
　　MsgBox "集計しました"
End Sub


	【67493】Re:Dictionaryについて

UO3 - 10/12/9(木) 10:21 -


	引用なし

	パスワード

▼八家九僧陀さん：

おはようございます

本件に限っては、Dictionaryを使わずとも、Hirofumiさんからでているコードのような処理、
あるいは、ＶＢＡを使わなくても、並び替えをした上で、データ->集計　で簡単に必要列の
個人別合計は取得できますので【いかんせん、実稼動させる期限がせまり余裕がなくあせっています。】
のであれば、手作業をお奨めします。
また、この集計をマクロ記録すれば、基本的なコードを取得できますのでそれをベースにブラッシュアップすれば
ＶＢＡによる実行もできるかと思います。

ただ、今後のことも含めて、Dictionaryを身に付けておきたいという目的であれば、それはそれとして
以下にコード案をアップします。

・Dictionaryは、処理効率は、かなり優れている。しかしながら、大量データの突合せ処理を
　おこなう場合は、並び替え->ループによるマージロジック　のほうが、より優れている。
　（というか、圧倒的に優れている）
・一方、ループによるマージロジックは、コードそのものが、けっして平易ではなく、バグつぶしに
　時間がかかることが多い。一方、Dictionaryは、いってみれば【ばかちょんカメラ】で、ロジックに
　悩むこともほとんどなく、コード部品としては、むしろ、初心者向き。
・また、他の機能（たとえばFileSystemObject)と比べ、圧倒的にメソッドやプロパティが【少なく】
　誰でも短期間に覚えることができるという利点もある。
・要素の格納という面では配列やCollectionに似ているが、要素の追加、上書き、取り出しにおいて
　両者よりも簡単に扱える部分が多い。

以下のサンプル、転記先シートのタイトル行と、各列の書式はセット済みという前提です。

Sub Sample()
　Dim dic As Scripting.Dictionary
　'Microsoft Scrinting Runtime 参照設定済みでなければ
　'Dim dic As Object
　Dim i As Long
　Dim id As String
　Dim pcode As String
　Dim v As Variant
　Dim myA As Range
　
　Set dic = New Scripting.Dictionary
　'Microsoft Scrinting Runtime 参照設定済みでなければ
　'Set dic = CreateObject("Scripting.Dictionary")
　Application.ScreenUpdating = False
　
　With Worksheets("支給台帳")
　　For i = 2 To .Range("C" & .Rows.Count).End(xlUp).Row
　　　id = .Cells(i, "C").Value
　　　pcode = .Cells(i, "D").Value
　　　If Not dic.Exists(id) Then
　　　　dic(id) = Array(id, pcode, 0, 0, 0)
　　　End If
　　　v = dic(id)
　　　v(2) = v(2) + .Cells(i, "CN").Value
　　　v(3) = v(3) + .Cells(i, "CO").Value
　　　v(4) = v(4) + .Cells(i, "BZ").Value
　　　dic(id) = v
　　Next
　End With
　
　With Worksheets("年調データ")
　　Set myA = Intersect(.UsedRange, .UsedRange.Offset(1, 0))
　　If Not myA Is Nothing Then myA.ClearContents
　　Set myA = Nothing
　　.Range("A2").Resize(dic.Count, 5).Value = _
　　　　Application.Transpose(Application.Transpose(dic.Items))
　End With
　
　Set dic = Nothing
　Application.ScreenUpdating = True
　
End Sub


	【67494】Re:Dictionaryについて

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


	引用なし

	パスワード

▼UO3 さん：

>ただ、今後のことも含めて、Dictionaryを身に付けておきたいという目的であれば、それはそれとして
>以下にコード案をアップします。

UO3さんのサンプルコードは
DictionaryのItemに ID,名前,集計項目を配列で持たせるものですね？

コードはとても簡潔になりますが、kanabunがやってるような出力表の
配列を別につくってそこで集計する(Dic＋Arrayの)方法とくらべ、
パフォーマンス的にはどうなんでしょうね？ (^^


	【67496】Re:Dictionaryについて

UO3 - 10/12/9(木) 14:18 -


	引用なし

	パスワード

▼kanabun さん：

こんにちは。
ご指摘ありがとうございます。

私の方式でも、別途の配列に入れなおしたほうが早いと思います。
少なくともTransposeの２連発は避けられますので。
いつか計測しようと、気にはなっているのですが、そのまま手抜きで。

さらに、Dictionaryは、kanabunさんの方式、IDのチェックのみに使用し
最初から配列というほうが、もっと早いのでしょうね。
配列の要素数という課題はありますが、ときおり Preserve　すればいいことですしね。


	【67499】Re:Dictionaryについて

kanabun - 10/12/9(木) 16:06 -


	引用なし

	パスワード

▼UO3 さん：こんにちは～

>いつか計測しようと、気にはなっているのですが、そのまま手抜きで。
>
>さらに、Dictionaryは、kanabunさんの方式、IDのチェックのみに使用し
>最初から配列というほうが、もっと早いのでしょうね。

> CN列＝課税所得額、BZ列＝社会保険控除額、CO列＝源泉徴収税額
ですので、
Hirofumi さんの
>　 '列位置をA列を1列として、列挙する
>　　vntPost = Array(3, 4, 78, 92, 93)
は
　　vntPost = Array(3, 4, 92, 78, 93)
ですか？

UO3 さんの
>　　　v(2) = v(2) + .Cells(i, "CN").Value
>　　　v(3) = v(3) + .Cells(i, "CO").Value
>　　　v(4) = v(4) + .Cells(i, "BZ").Value
は、
　　　v(2) = v(2) + .Cells(i, "CN").Value
　　　v(4) = v(4) + .Cells(i, "CO").Value
　　　v(3) = v(3) + .Cells(i, "BZ").Value
ですかね？

で、timeGetTime()で測ってみると、
---------　--------(ms)
Sample_1　　　134
Sample_2　　　 31
集計_12か月分　31
Sample　　　　135

といった感じでした。

ワークシート関数のTransposeが高速ということは
最近別スレで UO3さんに教わりましたので
ここでも利用させていただいてます♪

>配列の要素数という課題はありますが、ときおり Preserve　すればいいことですしね。
シートに貼り付けるのですから、課題はありません。最初に余裕のある
要素数を宣言しておいて、Loop後に分かった実際の行数だけ貼りつけています(^^


	【67500】Re:Dictionaryについて

kanabun - 10/12/9(木) 16:12 -


	引用なし

	パスワード

いま気がつきましたけど

>　　　If Not myID(i, 1) = Empty Then

はオリジナルこーどでそうなってたのでついそのまま使わせてもらいましたが
ここは ▼

　　　If Not IsEmpty(myID(i, 1)) Then

のほうがよかったと思います。(大勢に影響はないでしょうけど)


	【67505】Re:Dictionaryについて

Hirofumi - 10/12/9(木) 18:05 -


	引用なし

	パスワード

ゴメン、kanabunさんの指摘通り、間違っていましたね

　　'"支給台帳"の社員ID、氏名、課税所得額、社会保険控除額、源泉徴収税額の
　　'列位置をA列を1列として、列挙する
'　　vntPost = Array(3, 4, 78, 92, 93)
　　vntPost = Array(3, 4, 92, 78, 93)


	【67506】Re:Dictionaryについて

Hirofumi - 10/12/9(木) 18:06 -


	引用なし

	パスワード

▼kanabun さん：
>いま気がつきましたけど
>
>>　　　If Not myID(i, 1) = Empty Then
>
>はオリジナルこーどでそうなってたのでついそのまま使わせてもらいましたが
>ここは ▼
>
>　　　If Not IsEmpty(myID(i, 1)) Then
>
>のほうがよかったと思います。(大勢に影響はないでしょうけど)

と言うより、不要の様な気がしますが？

　　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(1, n) = myID(i, 1)
　　　　　　　　vout(2, n) = myName(i, 1)
　　　　　　End If
　　　　　　vout(3, n) = vout(3, n) + v課税所得(i, 1)
　　　　　　vout(4, n) = vout(4, n) + v社保控除(i, 1)
　　　　　　vout(5, n) = vout(5, n) + v源泉徴収(i, 1)
'　　　　End If　'★不要
　　Next


	【67507】Re:Dictionaryについて

八家九僧陀 - 10/12/9(木) 18:15 -


	引用なし

	パスワード

▼Hirofumi さん：
ほんとに感謝、感謝です。ありがとうございます。
他2名の方からも回答をいただき、わからぬままに、各コードを転記して早速試してみました。
ところが
hirofumiさんの２案とも、

>　　
>　　'1行目～最終行まで繰り返し
>　　For i = 1 To lngRows
>　　　　'"支給台帳"の1行分を配列として取得

　　　　vntData = rngList.Offset(i).Resize(, clngColumns).Value

の部分でデバッグとなり、「コンパイルエラー　配列には割り当てられません」とのメーセージがでてうまくいきません。

プログラム作成作業は、仕事を終えて自宅のパソコンで作業をしてFDに収めて、それを会社のパソコンに入れています。
肝心の使用環境を漏らしましたが、自宅のはexcel97、会社はexcel2003です。
excel97ではご教示いただいた２案ともカバーできないのでしょうか。


	【67508】Re:Dictionaryについて

八家九僧陀 - 10/12/9(木) 18:22 -


	引用なし

	パスワード

▼kanabun さん：

ほんとに感謝、感謝です。ありがとうございます。
他2名の方からも回答をいただきましたが、kanabunnさんのものが、「Dim myID, myName, v課税所得, v社保控除, v源泉徴収」等、私の使用する項目名を使っていただき、わかりやすいと思ったので真っ先に転記して早速試してみました。
ところが
　　
>　　' --- 集計結果配列voutのシートへの書き出し
>　　With Worksheets("年調データ")
>　　　　.UsedRange.ClearContents
　　　.Range("A1").Resize(k + 1, 5).Value = Application.Transpose(vout)

の部分でデバッグとなり、「型が一致しません」とのメーセージがでてうまくいきません。

肝心の使用環境を漏らしましたが、自宅のはexcel97、会社はexcel2003です。
excel97ではご教示いただいたコードは、できないのでしょうか。


	【67509】Re:Dictionaryについて

八家九僧陀 - 10/12/9(木) 18:31 -


	引用なし

	パスワード

▼UO3 さん：
ご教示ありがとうございます。
データ量により、どの方法を選択してよいか迷うほど、知識が全く豊富ではないレベルですので、この際「バカちょんカメラ」レベルのDictionaryを教えていただいて、それからバカのひとつ覚え的に他にも活用して、使い慣れて、レベルアップできればと思っています。
これからもご教示お願いします。
ありがとうございました。


	【67510】Re:Dictionaryについて

kanabun - 10/12/9(木) 18:46 -


	引用なし

	パスワード

▼八家九僧陀さん：
>▼kanabun さん：
> kanabunnさんのものが、「Dim myID, myName, v課税所得, v社保控除, v源泉徴収」等、私の使用する項目名を使っていただき、わかりやすいと思ったので真っ先に転記して早速試してみました。
>ところが

>　　　.Range("A1").Resize(k + 1, 5).Value = Application.Transpose(vout)
>
>の部分でデバッグとなり、「型が一致しません」とのメーセージがでてうまくいきません。
>
>肝心の使用環境を漏らしましたが、自宅のはexcel97、会社はexcel2003です。
>excel97ではご教示いただいたコードは、できないのでしょうか。

あ、そういえば、八家九僧陀さんの環境を失念していましたm(_ _)m
Transpose関数は Excelのバージョン2000まででは、要素数の制限が
あり、配列内の要素数が 5461 を超えることはできません。

自前で配列をTransposeすることになりますが、
　 ht tp://support.microsoft.com/kb/246335/ja
あたりにそのサンプルがのっていますので、ちょっと読んでみてください。
Excel2002からは大丈夫です。


	【67511】Re:Dictionaryについて

Hirofumi - 10/12/9(木) 19:03 -


	引用なし

	パスワード

>の部分でデバッグとなり、「コンパイルエラー　配列には割り当てられません」とのメーセージがでてうまくいきません。

此れは、Excel97のVBAがVer5.Xで、Excel2000以降がVer6.Xなので其の違いで動きません
2案共に、以下の様に変更して下さい
尚、この変更を行っても、そのままExcel2003でも使えます

　　Dim i As Long
　　Dim j As Long
　　Dim lngRows As Long
　　Dim rngList As Range
　　Dim rngResult As Range
　　Dim vntPost As Variant
'　　Dim vntData() As Variant
　　Dim vntData As Variant '★変更
　　Dim vntResult() As Variant
　　Dim lngWrite As Long
　　Dim strProm As String

★印の様に、()を削除して下さい


	【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


	【67575】Re:Dictionaryについて

八家九僧陀 - 10/12/15(水) 0:48 -


	引用なし

	パスワード

▼Hirofumi さん：

返事が送れて申し訳ありません。
>★印の様に、()を削除して下さい
ご指摘のとおり修正したところ、思った通りのことができました。
()を削除しただけで、できるとは低レベルの私には全く？？？？？なのですが、
本当に感謝、感謝です。ありがとうございました。

>>の部分でデバッグとなり、「コンパイルエラー　配列には割り当てられません」とのメーセージがでてうまくいきません。
>
>此れは、Excel97のVBAがVer5.Xで、Excel2000以降がVer6.Xなので其の違いで動きません
>2案共に、以下の様に変更して下さい
>尚、この変更を行っても、そのままExcel2003でも使えます
>
>　　Dim i As Long
>　　Dim j As Long
>　　Dim lngRows As Long
>　　Dim rngList As Range
>　　Dim rngResult As Range
>　　Dim vntPost As Variant
>'　　Dim vntData() As Variant
>　　Dim vntData As Variant '★変更
>　　Dim vntResult() As Variant
>　　Dim lngWrite As Long
>　　Dim strProm As String
>
>★印の様に、()を削除して下さい


	【67576】Re:Dictionaryについて

八家九僧陀 - 10/12/15(水) 0:57 -


	引用なし

	パスワード

▼kanabun さん：
返事が送れて申し訳ありません。
試してみたのですが、
>　　vout(0, 1) = "ID"
のところで「インデックスが有効範囲にありません」とのエラーが出て黄色に反転します。
ほんとに”世話のかかるやつ”ですが、どこをどう直せばいいのでしょうか？

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


	【67577】Re:Dictionaryについて

kanabun - 10/12/15(水) 9:25 -


	引用なし

	パスワード

▼八家九僧陀さん：

>試してみたのですが、
>>　　vout(0, 1) = "ID"
>のところで「インデックスが有効範囲にありません」とのエラーが出て黄色に反転します。

こちらではそのとおりに書いてあればそのようなエラーは起きないので、
原因は不明ですが、

>>　　' ---社員ID別金額集計
>>　　ReDim vout(1000, 1 To 5)
>>　　vout(0, 1) = "ID"
>>　　vout(0, 2) = "氏名"
>>　　vout(0, 3) = "課税所得額"
>>　　vout(0, 4) = "社会保険控除額"
>>　　vout(0, 5) = "源泉徴収税額"

と書いてあるとき、
>>　　ReDim vout(1000, 1 To 5)
は
　　ReDim vout(0 To 1000, 1 To 5)
　　　　　　　^^^^^^
という意味です。（配列の要素番号の最小値は 0 ということです）

ところが、モジュールの先頭に
Option Base 1
ともし書いてあると、
>>　　ReDim vout(1000, 1 To 5)
は
　　ReDim vout(1 To 1000, 1 To 5)
　　　　　　　^^^^^^
の意味になってしまい、添字0 は含まれないことになるので、
>>　　vout(0, 1) = "ID"
>>　　vout(0, 2) = "氏名"
>>　　vout(0, 3) = "課税所得額"
>>　　vout(0, 4) = "社会保険控除額"
>>　　vout(0, 5) = "源泉徴収税額"
はエラーになります。

念のため、

　　ReDim vout(0 To 1000, 1 To 5)

に直して実行したばあいの、結果をお知らせください。


	【67582】Re:Dictionaryについて

八家九僧陀 - 10/12/15(水) 22:30 -


	引用なし

	パスワード

▼kanabun さん：
大変、大変申しわけありません。

　ReDim vout(1000, 1 To 5)
　　vout(0, 1) = "ID"
　　vout(0, 2) = "氏名"
　　vout(0, 3) = "課税所得額"
　　vout(0, 4) = "社会保険控除額"
　　vout(0, 5) = "源泉徴収税額"
のところを
　　vout(1, 0) = "ID"
　　vout(2, 0) = "氏名"
　　vout(3, 0) = "課税所得額"
　　vout(4, 0) = "社会保険控除額"
　　vout(5, 0) = "源泉徴収税額"
のままにしていました。
　ReDim vout(0 to 1000, 1 To 5)
　　vout(0, 1) = "ID"
　　vout(0, 2) = "氏名"
　　vout(0, 3) = "課税所得額"
　　vout(0, 4) = "社会保険控除額"
　　vout(0, 5) = "源泉徴収税額"
に修正して試したところ、実行できました。

重ね重ね大変申し訳ありませんでした。
また本当にお世話をお掛けして、ありがとうございました。
他の件で、まだまだこのコーナーを利用させてもらいますので、これに懲りずにご教示をお願いします。
ほんとうにありがとうございました。


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

2512 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free