Excel VBA質問箱 IV

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

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


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

38321 / 76732

←次へ　｜　前へ→


	【43549】Re:集計（かなり複雑です）

壁 - 06/10/19(木) 10:16 -


	引用なし

	パスワード

ありがとうございます。
集計値をL列にセットするような形にしました。
修正しやすく、分かりやすかったです。
こういう風に教えてもらうとかなり勉強になりました。

Sub 営業所別集計_保存()
　 Dim SAry As Variant, Ary1 As Variant, Ary2 As Variant
　 Dim Snm As String, NewB As String
　 Dim i As Integer, Ans As Integer

　 SAry = Array("SZ_AA", "SZ_AB", "SZ_AC", "3Z", "5Z", "KZ")
　 Ary1 = Array("01", "02", "03", "04", "05", _
　 "0A", "0B", "0C", "0D", "総計")
Ary2 = Array("東北", "関西", "北海道", "九州", _
　 "広島", "島根", "鳥取", "東京", "沖縄")
　 With Application
　　　.ScreenUpdating = False
　　　.DisplayAlerts = False
　 End With
　 Worksheets.Add Before:=Worksheets(1), Count:=6
　 With Worksheets(1)
　　　Worksheets(7).Rows(1).Copy .Range("A1")
　　　With .Range("C2:C11")
　　　　 .NumberFormat = "@"
　　　　 .Value = WorksheetFunction.Transpose(Ary1)
　　　End With
　　　.Range("D2:D10").Value = WorksheetFunction _
　　　.Transpose(Ary2)
　　　Sheets(Array(1, 2, 3, 4, 5, 6)) _
　　　.FillAcrossSheets .Range("A1:IV11")
　 End With
　 For i = 6 To 1 Step -1
　　　Snm = SAry(i - 1) & "集計"
　　　NewB = ThisWorkbook.Path & "\" & "海外直販_ "& Snm & ".xls"　　　　　　　　　　If Dir(NewB) <> "" Then
　　　　 If Ans = 7 Then
　　　　　　Worksheets(i).Delete: GoTo NLine
　　　　 End If
　　　End If
　　　With Worksheets(i)
　　　　 .Name = Snm
　　　　 Fom = "=SUMIF(" & SAry(i - 1) & "!$C:$C,$C2," & _
　　　　 SAry(i - 1) & "!L:L)"
　　　　 .Range("L2:T10").Formula = Fom　　　　　　　　　　　　　　　　　　　'どの列に集計を配置するか指定。
　　　　 .Range("L11:T11").Formula = "=SUM(L$2:L$10)"　　　　　　　　　'総計L～T列11行目
　　　　 With .Range("L2:T11")
　　　　　　.Value = .Value
　　　　 End With
　　　　 .Move
　　　End With
　　　ActiveWorkbook.Close True, NewB
NLine:
　 Next i
　 With Application
　　　.ScreenUpdating = True
　　　.DisplayAlerts = True
　 End With

End Sub

0 hits

▼

【43514】集計（かなり複雑です） 壁 06/10/18(水) 15:06