いつもお世話になっております
シート名 1 2 3 があります。
シートごとに 個数と集計をしたいのです。
シートごとです。
わかる方教えてくれませんでしょぅか
Sub erfssa()
Dim Dic As Object
Set Dic = CreateObject("Scripting.Dictionary")
Dim val
val = Range("B2").CurrentRegion.Offset(1).Value
Dim wS As Worksheet
aay = Array("1", "2", "3")
For i = LBound(aay) To UBound(aay)
For Each r In Worksheets(aay(i)).Range("B3", Cells(Rows.Count, 2).End(xlUp))
If Not Dic.Exists(r.Value) Then
Dic.Add r.Value, Array(1, WorksheetFunction.Sum(r.Offset(, 1).Value))
Else
v = Dic(r.Value)
v(0) = v(0) + 1
v(1) = v(1) + WorksheetFunction.Sum(r.Offset(, 1).Value)
Dic(r.Value) = v
End If
Next
Dim rr As Range
Set rr = Range("E2")
For Each Key In Dic.Keys
rr.Value = Key
rr.Offset(, 1).Resize(, 2) = Dic(Key)
Set rr = rr.Offset(1)
Next
Next
End Sub
No.1
- 回答日時:
こんばんは
>シートごとに 個数と集計をしたいのです
何の個数を、どのように集計したいのかがサッパリわかりません。
仮に計算できたとしても、それをどうしたいのかもわかりません。
(なさりたいことをキチンと伝えないと、回答のしようがありません。)
全くの当てずっぽうで、勝手に以下と推測。
(違っている場合は、以下はすべて無視してください)
・対象範囲は、各シートのB列3行目から最終行までと想定。
・「集計」とは、対象範囲の中の、数値の合計を求めるものと想定。
・「個数」とは、対象範囲の中の、数値の個数を求めるものと想定。
・結果は、とりあえずイミディエイトウインドウに出力します。
以下、ご参考にでもなれば。
(エラー処理等は、一切行っていません)
Sub Sample()
Dim ws As Worksheet, rng As Range
Dim aay, rw As Long, i As Long
aay = Array("1", "2", "3")
For i = LBound(aay) To UBound(aay)
Set ws = Worksheets(aay(i))
rw = Application.Max(ws.Cells(Rows.Count, 2).End(xlUp).Row, 3)
Set rng = Range(ws.Cells(3, 2), ws.Cells(rw, 2))
Debug.Print "シート名:" & ws.Name
Debug.Print "個数:" & WorksheetFunction.Count(rng)
Debug.Print "合計:" & WorksheetFunction.Sum(rng) & vbCrLf
Next i
End Sub
No.2ベストアンサー
- 回答日時:
データがどこの列にあるかで悩みました。
Sub megu()
Dim Dic As Object
Dim r As Range, rr As Range
Dim aay, ar_ws, key, v
Set Dic = CreateObject("Scripting.Dictionary")
aay = Array("1", "2", "3")
For Each ar_ws In aay
With Worksheets(ar_ws)
Set rr = .Range("E2")
For Each r In .Range("B3", .Cells(Rows.Count, 2).End(xlUp))
If Not Dic.Exists(r.Value) Then
Dic.Add r.Value, Array(1, r.Offset(, 1).Value)
Else
v = Dic(r.Value)
v(0) = v(0) + 1
v(1) = v(1) + r.Offset(, 1).Value
Dic(r.Value) = v
End If
Next
For Each key In Dic.Keys
rr.Value = key
rr.Offset(, 1).Resize(, 2) = Dic(key)
Set rr = rr.Offset(1)
Next
Dic.RemoveAll
End With
Next
Set Dic = Nothing
Set rr = Nothing
End Sub
いつもお世話になっております
わかりにくい
質問で申し訳ございませんでした。
うまくいきました。
とても嬉しいです。
ありがとうございました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) ワークシートごとに計算結果 2 2022/04/30 22:00
- Visual Basic(VBA) excel vbaでvlooupの変数がわかりません。 7 2022/05/30 09:35
- Visual Basic(VBA) VBAが止まります。 1 2022/09/02 14:51
- Visual Basic(VBA) 稀に1円合いません? Sheet1から金額と個数を貼り付ける下記コードで、金額を切り上げるコードを何 3 2022/09/05 15:11
- Visual Basic(VBA) まとめシートから集計シートへA列のコードが一致したら1行コピーするマクロをネット上で見つけました。こ 1 2022/08/30 14:11
- Excel(エクセル) マクロで行を追加、削除すると行位置がずれますが、解決方法はありませんか?。 5 2022/05/28 16:03
- Visual Basic(VBA) エラーコード1004 6 2022/06/09 14:12
- Visual Basic(VBA) オブジェクトが見つかりません 1 2023/06/24 19:43
- Excel(エクセル) なぜExit Subがあるのかわかりません 4 2023/02/19 12:34
- Excel(エクセル) vba シート名の一覧を2列に分けるには 5 2023/04/24 08:56
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
別のシートから値を取得するとき
-
VBAの天才来てください
-
【ExcelVBA】全シートのセルの...
-
ユーザーフォームに入力したデ...
-
エクセルのマクロでアクティブ...
-
VBA 存在しないシートを選...
-
同じ作業を複数のシートに実行...
-
ExcelのVBAのマクロで他のシー...
-
エクセルのシート名変更で重複...
-
【VBA】シート名に特定文字が入...
-
【VBA】色のついたシート名を取得
-
ExcelVBA:複数の特定のグラフ...
-
ExcelVBA シート名を複数セルか...
-
XL:BeforeDoubleClickが動かない
-
VBAを用いて繰り返し自動的...
-
excelのマクロで該当処理できな...
-
VBA ユーザーフォーム上のチェ...
-
Excel マクロについての相談
-
特定の文字を含むシートだけマ...
-
エクセル・マクロ シートの非...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
別のシートから値を取得するとき
-
ユーザーフォームに入力したデ...
-
Excelマクロのエラーを解決した...
-
excelのマクロで該当処理できな...
-
同じ作業を複数のシートに実行...
-
ExcelVBA シート名を複数セルか...
-
【ExcelVBA】全シートのセルの...
-
Excel マクロについての相談
-
VBA 存在しないシートを選...
-
実行時エラー'1004': WorkSheet...
-
特定の文字を含むシートだけマ...
-
ExcelのVBAのマクロで他のシー...
-
ブック名、シート名を他のモジ...
-
XL:BeforeDoubleClickが動かない
-
VBA 複数の各シートに行を追加...
-
エクセルのシート名変更で重複...
-
【Excel VBA】Worksheets().Act...
-
シートが保護されている状態で...
-
Excel VBA 複数行を数の分だけ...
-
for 文の 繰り返し処理に使える...
おすすめ情報
画像添付できませんでした。
シート名1 同様シート名2 3 に
も
支社 売上 青森支社 3 10500
青森支社 1500 秋田支社 3 12000
秋田支社 2000 福島支社 3 13500
福島支社 2500 岩手支社 2 8000
岩手支社 3000
青森支社 3500
秋田支社 4000
福島支社 4500
岩手支社 5000
青森支社 5500
秋田支社 6000
福島支社 6500
シート2
支社 売上 青森支社 5 19500
青森支社 1500 秋田支社 4 16000
秋田支社 2000 福島支社 4 18000
福島支社 2500 岩手支社 3 13000
岩手支社 3000
青森支社 3500
秋田支社 4000
福島支社 4500
岩手支社 5000
青森支社 5500
秋田支社 6000
福島支社 6500
青森支社 3500
秋田支社 4000
福島支社 4500
岩手支社 5000
青森支社 5500
シート2
支社 売上 青森支社 5 19500
青森支社 1500 秋田支社 4 16000
秋田支社 2000 福島支社 4 18000
福島支社 2500 岩手支社 3 13000
岩手支社 3000
青森支社 3500
秋田支社 4000
福島支社 4500
岩手支社 5000
青森支社 5500
秋田支社 6000
福島支社 6500
青森支社 3500
秋田支社 4000
福島支社 4500
岩手支社 5000
青森支社 5500
シート3
支社 売上 青森支社 5 19500
青森支社 1500 秋田支社 4 16000
秋田支社 2000 福島支社 4 18000
福島支社 2500 岩手支社 3 13000
岩手支社 3000
青森支社 3500
秋田支社 4000
福島支社 4500
岩手支社 5000
青森支社 5500
秋田支社 6000
福島支社 6500
青森支社 3500
秋田支社 4000
福島支社 4500
岩手支社 5000
青森支社 5500
すいません、シート2だぶりました。