Excel VBA質問箱 IV

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

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


45045 / 76732 ←次へ | 前へ→

【36694】Re:特定の文字列をシート名に含むシートのみ串刺し計算
発言  ponpon  - 06/4/8(土) 12:12 -

引用なし
パスワード
   こんにちは。
Dictionaryの練習に作ってみました。
うまくいくかどうか自信はありませんが、試してみてください。
エラー処理などは、出来ていません。


Sub test()
  Dim mySHnm As String
  Dim NewSH As Worksheet
  Dim SH As Worksheet
  Dim myDic As Object
  Dim myVal As Variant
  Dim myVal2 As Variant
  
  '「・・の合計」のシートの削除
  Application.ScreenUpdating = False
  For Each SH In ThisWorkbook.Worksheets
    Application.DisplayAlerts = False
    If Right$(SH.Name, 2) = "合計" Then
     SH.Delete
    End If
    Application.DisplayAlerts = True
  Next
  
  'シートネームの左から3文字を辞書のkeyに、D18からD30をitemに格納
  Set myDic = CreateObject("Scripting.Dictionary")
  For i = 1 To ThisWorkbook.Worksheets.Count
   mySHnm = Left$(Sheets(i).Name, 3)
   myVal = Sheets(i).Range("D18", Sheets(i).Range("D30")).Value
   If Not myDic.exists(mySHnm) Then
     myDic(mySHnm) = myVal
   Else  '同じkeyなら配列の足し算
     myVal2 = myDic(mySHnm)
     For j = 1 To UBound(myVal2)
      myVal2(j, 1) = myVal2(j, 1) + myVal(i, 1)
     Next
     myDic(mySHnm) = myVal2
   End If
  Next
  
  'key毎にシートを追加、itemの転記
  For Each mykey In myDic.Keys
    Set NewSH = Worksheets.Add(after:=Sheets(Sheets.Count))
    With NewSH
      .Name = mykey & "合計"
      .Range("D18", .Range("D30")).Value = myDic(mykey)
    End With
  Next
  Application.ScreenUpdating = True
  Set myDic = Nothing: Set NewSH = Nothing
End Sub

1 hits

【36692】特定の文字列をシート名に含むシートのみ串刺し計算 VBA☆ 06/4/8(土) 8:51 質問
【36693】Re:特定の文字列をシート名に含むシートの... VBA☆ 06/4/8(土) 8:57 質問
【36694】Re:特定の文字列をシート名に含むシートの... ponpon 06/4/8(土) 12:12 発言
【36695】Re:特定の文字列をシート名に含むシートの... Kein 06/4/8(土) 12:38 回答
【36698】Re:特定の文字列をシート名に含むシートの... Hirofumi 06/4/8(土) 15:16 回答
【36701】Re:特定の文字列をシート名に含むシートの... ichinose 06/4/8(土) 20:08 発言
【36702】Re:特定の文字列をシート名に含むシートの... ichinose 06/4/9(日) 8:10 発言
【36703】みなさまありがとうございます VBA☆ 06/4/9(日) 14:49 お礼
【36773】遅くなりました。 [名前なし] 06/4/13(木) 14:56 質問
【36779】Re:遅くなりました。 Kein 06/4/13(木) 16:16 回答
【36789】Re:遅くなりました。 ponpon 06/4/13(木) 21:19 発言

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