Excel VBA質問箱 IV

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

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


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

14736 / 76734

←次へ　｜　前へ→


	【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

2 hits

▼

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