Results of 1 - 1 of about 48829 for A�����������������������... (0.009 sec.)
- [[20190322123409]]
- #score: 1420
- @digest: 8d0edba8126236828648ef3c3e766194
- @id: 79034
- @mdate: 2019-03-23T08:06:31Z
- @size: 7835
- @type: text/plain
- #keywords: 社商 (11574), 価" (9638), 評価 (6959), 品7 (6634), vbnarrow (6539), 価1 (6525), アト (6450), 計結 (6109), 社a (5005), myarea (4963), ボロ (4905), strconv (4736), ィク (4162), lastrow (3833), 果") (3812), 連想 (3363), 想配 (3264), 商品 (2701), 日4 (2632), ubound (2583), ョナ (2509), 〜f (2506), 日a (2465), 日3 (2328), 品2 (2242), lbound (2132), 品1 (2089), ii (1919), 日2 (1878), 〜31 (1768), 日" (1700), 日〜 (1369)
- 『連想配列でCOUNTIFSみたいな集計を高速でしたいです。』（アト）
シートが二つ、データと集計結果があります。 データシートにはA列に会社名、B列に商品名、C列〜AH列まではカレンダーで日にちが入っていてその下に評価が入っています。 A列の各社ごとにB列の商品を何種類かもっており、数はまちまちです。 A列の会社数は1500くらいあります。 C列の評価はA〜Gまでです。 A列 B列 C列 D列 〜 AH列 1日 2日 3日 4日 〜 31日 A社 商品1 A B A D G 商品5 F D G C F 商品2 B C F A A 商品7 A C A D F B社 商品3 A B A D G 商品6 F D G C F 商品2 B C F A A 商品1 A C A D F C社 商品4 A B A D G 商品8 F D G C F 商品9 B C F A A 商品7 A C A D F 上記のような表から集計シートに会社名毎にC列の評価の数を下記にように集計したいのです。 A列 B列 C列 D列 評価 1日 2日 3日 4日 〜 31日 A社 A〜F 10 8 5 9 6 AとB 6 5 3 7 4 A 4 4 2 5 3 評価 1日 2日 3日 4日 〜 31日 B社 A〜F 12 7 5 9 6 AとB 6 6 3 7 4 A 4 2 2 5 3 評価 1日 2日 3日 4日 〜 31日 C社 A〜F 10 5 5 9 6 AとB 6 4 3 7 4 A 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) = "A〜F" b(n + 1, 2) = "AとB": b(n + 2, 2) = "A" End If If n > 0 Then For ii = 3 To UBound(a, 2) If a(i, ii) Like "[A-F]" Then b(n, ii) = b(n, ii) + 1 If a(i, ii) Like "[AB]" Then b(n + 1, ii) = b(n + 1, ii) + 1 If a(i, ii) = "A" 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 ---- 返信ありがとうございます。 説明不足で申し訳ありません。 集計結果シートに各社毎、日付毎に商品名は関係なく評価の数を数えたかったんです。 A社の1日はA〜F評価がいくつあるか、AとB評価はいくつあるかっていう質問内容でした。 色々試行錯誤しても時間がかかってしまい質問させて頂きました。 （アト） 2019/03/22(金) 18:21 ---- 参考に Sub Test() 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〜F", "AとB", "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... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201903/20190322123409.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97013 documents and 608132 words.
訪問者：