プロが教える店舗&オフィスのセキュリティ対策術

いつもお世話になっております

シート名 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

質問者からの補足コメント

  • 画像添付できませんでした。
    シート名1 同様シート名2 3 に


    支社 売上    青森支社 3 10500
    青森支社 1500 秋田支社 3 12000
    秋田支社 2000 福島支社 3 13500
    福島支社 2500 岩手支社 2 8000
    岩手支社 3000
    青森支社 3500
    秋田支社 4000
    福島支社 4500
    岩手支社 5000
    青森支社 5500
    秋田支社 6000
    福島支社 6500

      補足日時:2021/10/25 22:07
  • シート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

      補足日時:2021/10/25 22:09
  • シート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

      補足日時:2021/10/25 22:10
  • シート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

      補足日時:2021/10/25 22:11
  • へこむわー

    すいません、シート2だぶりました。

      補足日時:2021/10/25 22:12
gooドクター

A 回答 (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
    • good
    • 0
この回答へのお礼

いつもお世話になっております
わかりにくい
質問で申し訳ございませんでした。
うまくいきました。
とても嬉しいです。

ありがとうございました。

お礼日時:2021/10/26 08:18

こんばんは



>シートごとに 個数と集計をしたいのです
何の個数を、どのように集計したいのかがサッパリわかりません。
仮に計算できたとしても、それをどうしたいのかもわかりません。
(なさりたいことをキチンと伝えないと、回答のしようがありません。)

全くの当てずっぽうで、勝手に以下と推測。
(違っている場合は、以下はすべて無視してください)
・対象範囲は、各シートの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
    • good
    • 0
この回答へのお礼

ありがとうございます
これをシートごとセルに
表示させるようにやってみます。

お礼日時:2021/10/25 23:01

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング