Excel VBA質問箱 IV

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

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


14733 / 76734 ←次へ | 前へ→

【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

1 hits

【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 お礼

14733 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free