[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『連想配列でCOUNTIFSみたいな集計を高速でしたいです。』（アト）
シートが二つ、データと集計結果があります。
データシートにはＡ列に会社名、Ｂ列に商品名、Ｃ列〜ＡＨ列まではカレンダーで日にちが入っていてその下に評価が入っています。
Ａ列の各社ごとにＢ列の商品を何種類かもっており、数はまちまちです。
Ａ列の会社数は1500くらいあります。
Ｃ列の評価はＡ〜Ｇまでです。
Ａ列 Ｂ列 Ｃ列 Ｄ列 〜 ＡＨ列
1日 2日 3日 4日 〜 31日
Ａ社 商品１ Ａ Ｂ Ａ Ｄ Ｇ
商品５ Ｆ Ｄ Ｇ Ｃ Ｆ
商品２ Ｂ Ｃ Ｆ Ａ Ａ
商品７ Ａ Ｃ Ａ Ｄ Ｆ
Ｂ社 商品３ Ａ Ｂ Ａ Ｄ Ｇ
商品６ Ｆ Ｄ Ｇ Ｃ Ｆ
商品２ Ｂ Ｃ Ｆ Ａ Ａ
商品１ Ａ Ｃ Ａ Ｄ Ｆ
Ｃ社 商品４ Ａ Ｂ Ａ Ｄ Ｇ
商品８ Ｆ Ｄ Ｇ Ｃ Ｆ
商品９ Ｂ Ｃ Ｆ Ａ Ａ
商品７ Ａ Ｃ Ａ Ｄ Ｆ
上記のような表から集計シートに会社名毎にＣ列の評価の数を下記にように集計したいのです。
Ａ列 Ｂ列 Ｃ列 Ｄ列
評価 1日 2日 3日 4日 〜 31日
Ａ社 Ａ〜Ｆ 10 8 5 9 6
ＡとＢ 6 5 3 7 4
Ａ 4 4 2 5 3
評価 1日 2日 3日 4日 〜 31日
Ｂ社 Ａ〜Ｆ 12 7 5 9 6
ＡとＢ 6 6 3 7 4
Ａ 4 2 2 5 3
評価 1日 2日 3日 4日 〜 31日
Ｃ社 Ａ〜Ｆ 10 5 5 9 6
ＡとＢ 6 4 3 7 4
Ａ 4 1 2 5 3
宜しくお願い致します。
＜ 使用 Excel：Excel2010、使用 OS：unknown ＞
集計結果の数値が理解できないけど、多分
Sub test()
Dim a, i As Long, ii As Long, n As Long
a = Sheets("sheet1").Cells(1).CurrentRegion.Value
ReDim b(1 To UBound(a, 1) * 3, 1 To UBound(a, 2))
n = 1: a(1, 2) = "評価"
For ii = 1 To UBound(a, 2)
b(n, ii) = a(1, ii)
Next
For i = 2 To UBound(a, 1)
If a(i, 1) <> "" Then
n = n + IIf(n = 1, 1, 4)
b(n, 1) = a(i, 1): b(n, 2) = "Ａ〜Ｆ"
b(n + 1, 2) = "ＡとＢ": b(n + 2, 2) = "Ａ"
End If
If n > 0 Then
For ii = 3 To UBound(a, 2)
If a(i, ii) Like "[Ａ-Ｆ]" Then b(n, ii) = b(n, ii) + 1
If a(i, ii) Like "[ＡＢ]" Then b(n + 1, ii) = b(n + 1, ii) + 1
If a(i, ii) = "Ａ" Then b(n + 2, ii) = b(n + 2, ii) + 1
Next
End If
Next
Sheets.Add.Cells(1).Resize(n + 3, UBound(b, 2)).Value = b
End Sub
（seiya ） 2019/03/22(金) 14:59
だらだらと書いていたら力業になっちゃたよぉ(^^;
Option Explicit
Sub てすと()
Dim MyA As Variant
Dim v As Variant
Dim vv As Variant
Dim x As Variant
Dim i As Long
Dim j As Long
Dim ii As Long
Dim k As Long
k = 1
Sheets("Sheet3").Cells.Clear
With Sheets("Sheet1")
MyA = .Range("A1", .Range("A" & .Rows.Count).End(xlUp)).Value
For i = LBound(MyA, 1) To UBound(MyA, 1)
If Not IsEmpty(MyA(i, 1)) Then
ReDim y(1 To 4, 1 To 33)
v = .Range("A" & i).CurrentRegion.Value
y(2, 1) = MyA(i, 1)
y(1, 2) = "評価"
y(2, 2) = "A〜F"
y(3, 2) = "AとB"
y(4, 2) = "A"
If i = 2 Then
vv = .Range("A" & i).CurrentRegion.Value
For j = LBound(v, 2) + 2 To UBound(vv, 2)
y(1, j) = j - 2 & "日"
For ii = LBound(v, 1) + 1 To UBound(v, 1)
If (StrConv(v(ii, j), vbNarrow) Like "[A-F]") Then y(2, j) = y(2, j) + 1
If (StrConv(v(ii, j), vbNarrow) = "A") + (StrConv(v(ii, j), vbNarrow) = "B") Then y(3, j) = y(3, j) + 1
If (StrConv(v(ii, j), vbNarrow) = "A") Then y(4, j) = y(4, j) + 1
Next
Next
Else
For j = LBound(v, 2) + 2 To UBound(vv, 2)
y(1, j) = j - 2 & "日"
If j <= UBound(v, 2) Then
For ii = LBound(v, 1) To UBound(v, 1)
If (StrConv(v(ii, j), vbNarrow) Like "[A-F]") Then y(2, j) = y(2, j) + 1
If (StrConv(v(ii, j), vbNarrow) = "A") + (StrConv(v(ii, j), vbNarrow) = "B") Then y(3, j) = y(3, j) + 1
If (StrConv(v(ii, j), vbNarrow) = "A") Then y(4, j) = y(4, j) + 1
Next
End If
Next
End If
With Sheets("Sheet3")
.Range("A" & k).Resize(UBound(y, 1), UBound(y, 2)).Value = y
k = k + UBound(y, 1) + 2
End With
End If
Next
End With
Erase MyA, y, v, vv
End Sub
すみません。m(__)m 間違えました。Gまでだったんですね(^^;
度々、すみません。 ディクショナリーは使ってませんでした(^^; 入れ物も都度、初期化しないと駄目でした。もう、、ボロボロです。(￣▽￣;) （SoulMan） 2019/03/22(金) 15:23
SoulManさん、こんにちわ。
提示された集計結果が理解できないので、ごく単純に加算しただけですが、ひょっとしてもっと深いかも... （seiya ） 2019/03/22(金) 16:09
seiya さん こんにちは！
タイトルに 連想配列 ってあったから、、学校の中からディクショナーをコピペして
書き出したら、、使ってないという(^^;、、、なんともはや、、手癖とは恐ろしい(笑)
>提示された集計結果が理解できないので、ごく単純に加算しただけですが、ひょっとしてもっと深いかも...
ですね。あまりにも解が違い過ぎますね。。。。
どんな結末が待っているのでしょう？？？？楽しみですね・・・ （SoulMan） 2019/03/22(金) 16:16
説明不足で申し訳ありません。
集計結果シートに各社毎、日付毎に商品名は関係なく評価の数を数えたかったんです。
Ａ社の1日はＡ〜Ｆ評価がいくつあるか、ＡとＢ評価はいくつあるかっていう質問内容でした。
色々試行錯誤しても時間がかかってしまい質問させて頂きました。
（アト） 2019/03/22(金) 18:21
Dim myArea As Range, c As Range, i As Long
Dim v(1 To 3, 1 To 31) As Long, LastRow As Long
Worksheets("集計結果").Cells.ClearContents
With Worksheets("データ").Range("B:B").SpecialCells(xlCellTypeConstants)
LastRow = 2
For Each myArea In .Areas
For i = 1 To 31
For Each c In myArea.Offset(, i)
If c.Value Like "[A-F]" Then v(1, i) = v(1, i) + 1
If c.Value Like "[A-B]" Then v(2, i) = v(2, i) + 1
If c.Value = "A" Then v(3, i) = v(3, i) + 1
Next
Next
With Worksheets("集計結果")
.Cells(LastRow, "B").Value = "評価"
.Cells(LastRow, "C").Value = "1日"
.Cells(LastRow, "C").AutoFill Destination:= _
.Cells(LastRow, "C").Resize(, 31), Type:=xlFillDefault
.Cells(LastRow + 1, "A").Value = myArea.Item(1).Offset(, -1).Value
.Cells(LastRow + 1, "B").Resize(3).Value = _
Application.Transpose(Array("Ａ〜Ｆ", "ＡとＢ", "A"))
.Cells(LastRow + 1, "C").Resize(3, 31).Value = v
LastRow = .Cells(Rows.Count, "C").End(xlUp).Row + 2
End With
Erase v
Next
End With
End Sub
（ピンク） 2019/03/23(土) 17:06
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.