Excel VBA質問箱 IV

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

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


2204 / 76734 ←次へ | 前へ→

【80174】部課ごとに各項目で集計したい
質問  名木  - 18/10/6(土) 14:55 -

引用なし
パスワード
   人事シートをもとに、社員部課別で指定した項目の集計をしたいと
思います。
シンプルで分かりやすいマクロを教えていただけないでしょうか?
結果を示すシートは[集計シート]とします。

Option Explicit

Sub ColCopy()
  Dim xlBook As Workbook
  Dim xlSheetOrg As Worksheet
  Dim xlSheetSel As Worksheet
  Dim xlSheetDst As Worksheet
  Dim strDstSheetName As String
  Dim rngLastRow As Range
  Dim vntIndex As Variant
  Dim rngIndexs As Range
  Dim rngHeader As Range
  Dim lngColSrc As Long
  Dim lngColDst As Long
  Dim rngTargetCol As Range
  
  
  Set xlBook = ThisWorkbook
  
  With xlBook
    Set xlSheetSel = .Worksheets("指定")
    Set xlSheetOrg = .Worksheets("人事")
  End With
  
  ' コピー先シート名取得
  strDstSheetName = xlSheetSel.Range("A2").Value
  
  ' コピー先シートを初期化(なければ生成)
  On Error GoTo ERR_DST_SHEET
  Set xlSheetDst = xlBook.Worksheets(strDstSheetName)
  With xlSheetDst
    .Cells.Clear
  End With
  On Error GoTo 0
  
  
  ' 項目名を読み取り
  With xlSheetSel
    Set rngLastRow = .Cells(.Rows.Count, 1).End(xlUp)
    Set rngIndexs = .Range(.Cells(21, 1), rngLastRow)
    Set rngLastRow = Nothing
  End With
  
  ' 見出し行の取り込み
  Set rngHeader = xlSheetOrg.Rows(1)
  
  ' 該当列のコピー
  Application.ScreenUpdating = False
  With xlSheetDst
    lngColDst = 0
    For Each vntIndex In rngIndexs
      lngColDst = lngColDst + 1
      Set rngTargetCol = rngHeader.Find(CStr(vntIndex))
      lngColSrc = rngTargetCol.Column
      rngTargetCol.EntireColumn.Copy .Cells(1, lngColDst)
      Set rngTargetCol = Nothing
    Next vntIndex
    Set rngIndexs = Nothing
  End With
  Application.ScreenUpdating = True
  
  GoTo PROC_END
  
ERR_DST_SHEET:
  Set xlSheetDst = Sheets.Add(, Sheets("集計"))
  xlSheetDst.Name = strDstSheetName
  Resume Next
  
PROC_END:
  Set rngHeader = Nothing
  Set xlSheetDst = Nothing
  Set xlSheetOrg = Nothing
  Set xlSheetSel = Nothing
  Set xlBook = Nothing

End Sub

[人事シート]
 A      B         C       D       E        F    G    
1社員氏名  社員部課    社員体系 平日出勤 休日出勤 出勤時間 残業手当A
2京都 太郎 パートフロアー パート                    
3山田 山太 生産      社員                    
4木本 樹  フロアー      社員                    


[指定シート]
    A列
1    集計先
2    集計
3    
4    項目名
5    社員氏名
6    社員部課
7    社員体系
8    支給合計
9    所得税
10    課税通勤手当
11    非課税通勤手当
12    時間外A金額
13    時間外B金額
14    時間外C金額
15    時間外D金額
16    健康保険料(一般)
17    健康保険料(介護)
18    厚生年金保険料
19    雇用保険料
20    住民税
21    控除項目4
22    控除項目5
4 hits

【80174】部課ごとに各項目で集計したい 名木 18/10/6(土) 14:55 質問[未読]
【80176】Re:部課ごとに各項目で集計したい マナ 18/10/6(土) 18:40 発言[未読]
【80177】Re:部課ごとに各項目で集計したい 名木 18/10/9(火) 8:51 発言[未読]
【80178】Re:部課ごとに各項目で集計したい マナ 18/10/9(火) 18:54 発言[未読]
【80179】Re:部課ごとに各項目で集計したい 名木 18/10/10(水) 9:59 発言[未読]

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