Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10 Pro : Excel 2016)
countifsをループもしくはコピーさせたい
投稿日時: 21/01/17 12:49:58
投稿者: うかい

タイトル通り、countifsをループさせて使いたいと考えています。
月次レポートを作成しているのですが、今まで関数でなんとか作成していたものの、
ここにきて関数では計算が三時間たっても終わらず、VBAでなんとかできないかと思っています。
レポートは分類ごとに日付、時間(1分単位)でデータをカウントしています。
(元データの名前は通信履歴ログといいます)
作ってみたWorksheetfunction関数は以下です。
 
Range(B21) = _
WorksheetFunction.CountIfs(Sheets("通信履歴ログ").Range("A1:A8000"), Range("$A21").Value, _
Sheets("通信履歴ログ").Range("B1:B8000"), Range("B$20").Value, _
Sheets("通信履歴ログ").Range("Q1:Q8000"), Range("$A$20").Value)
 
これを、【B21:BCK35】の範囲に数式をコピーもしくはループさせたいのですが、この後の式がわかりません。
教えていただけると幸いです。
よろしくお願いいたします。

回答
投稿日時: 21/01/17 14:16:13
投稿者: 半平太

>B21:BCK35
随分広い範囲ですね。21,600セルもありますが、本当?
まぁ、3時間も掛かっているところを見ると本当なんでしょうね。
  
数式の一つひとつが、8000行x3列を相手にするとなると気が遠くなります。
  
こう言うのは2分探索を活用できる形に持って行くのが賢い。
  
つまり、履歴ログが昇順になっている必要がある。(いないなら昇順に並べる)
そうすれば、あっという間に計算が終わる。(と思う)
  
‥と言うことで履歴ログが昇順になっているかどうか確認したい。
 
あと、細かい話ですが、
検索対象にA1セルが含まれていますね?
そこはタイトル行ではないのですか?

回答
投稿日時: 21/01/17 14:39:45
投稿者: 半平太

2分探索も必要なかったかもです。
 
(昇順になっている)履歴を上から順に見て行くだけの様な気がする。
検索値と合致しなくなったら、そこで当該検索値の検索を止め、
次の検索値の処理は、合致しなかった行から調べ始めればいい。
 
これなら、8000行x3を1回調べるだけで済む。

投稿日時: 21/01/17 14:41:37
投稿者: うかい

[quote="半平太"]
ご回答ありがとうございます。
こちらからも回答させていただきます。
 
>随分広い範囲ですね。21,600セルもありますが、本当?
残念ながら間違いないです…。Bセルから始まって0:00、0:01…と刻んでいくので、
23:59までたどり着くのにBCKまでかかります。
 
>‥と言うことで履歴ログが昇順になっているかどうか確認したい。
なっていませんでしたので、履歴ログを昇順に並び替えました。
 
あと、細かい話ですが、
検索対象にA1セルが含まれていますね?
そこはタイトル行ではないのですか?
>タイトル行でしたね…。おはずかしいです。修正しておきます。

回答
投稿日時: 21/01/17 15:48:56
投稿者: 半平太

>Bセルから始まって0:00、0:01…と刻んでいくので、
>23:59までたどり着くのにBCKまでかかります。
 
1日分ですね。
 
すると、A21からA35は何が入っているんですか?
時分データと早合点していたのですが。
 

投稿日時: 21/01/17 16:01:09
投稿者: うかい

半平太さん
説明不足ですみません。
A21:A35は日付になります。
たとえば先月分でしたら、12/1〜12/15ですね。
表のイメージは以下の感じです。
横に時刻、分類(1〜6)、縦に日付があり、表の中に件数がカウントされています。
 
 
分類│0:00│0:01│0:02│0:03│0:04│0:05
 1 │  │  │  │  │  │
----------------------------------------
12/1│ │ │ 1 │ │ │
12/2│ │ │ │ │ │
12/3│ │ │ │ 1 │ │
12/4│ │ │ │ │ │
12/5│ 2 │ │ │ │ │
 
 

投稿日時: 21/01/17 16:04:08
投稿者: うかい

すみません、ものすごくずれたので表のイメージは見なかったことにしてください
[/quote]

回答
投稿日時: 21/01/17 17:36:38
投稿者: 半平太

Dictionaryオブジェクトを使うことにしました。
取り敢えず、これでどれくらいの速度が出るか測ってみてください。
※初めに「分類」でデータを絞り込んでおけば、もう少し速くなると思われます。
 

Sub test()
    Dim wsLog As Worksheet
    Dim dictLOG As Object
    Dim ky As Variant
    Dim ResultAry As Variant
    Dim KeyAry
    Dim RW As Long, CL As Long
    Dim RWs As Range
    
    Set wsLog = Sheets("通信履歴ログ")
    Set dictLOG = CreateObject("Scripting.Dictionary")
    
    For Each RWs In wsLog.Range("A2", wsLog.Cells(wsLog.Rows.Count, "Q").End(xlUp)).Rows
        With RWs
            ky = .Range("Q1") & Format(.Range("A1") + .Range("B1"), "♪yyyymmddhhmm")
            dictLOG(ky) = dictLOG(ky) + 1
        End With
    Next
    
    Application.ScreenUpdating = False
    
    With Sheets("Result").Range("B21:BCK35")
        'keyの配列を数式で作成する
        
        .FormulaLocal = "=$A$20&TEXT($A21+B$20,""♪yyyymmddhhmm"")"
        KeyAry = .Value2
        
        .ClearContents
        ResultAry = .Value2 '結果格納配列を用意する
        
        For RW = 1 To 15
            For CL = 1 To 1440
                ResultAry(RW, CL) = dictLOG(KeyAry(RW, CL))
            Next CL
        Next RW
        .Value = ResultAry
    End With
    
    Application.ScreenUpdating = True
    dictLOG.RemoveAll
End Sub

 

回答
投稿日時: 21/01/17 19:10:25
投稿者: 半平太

少々ゴミを除きしました。
 

Sub test()
    Dim wsLog As Worksheet
    Dim dictLOG As Object
    Dim ky
    Dim ResultAry(1 To 15, 1 To 1440)
    Dim KeyAry
    Dim RW As Long, CL As Long
    Dim RWs As Range
    
    Set wsLog = Sheets("通信履歴ログ")
    Set dictLOG = CreateObject("Scripting.Dictionary")
    
    For Each RWs In wsLog.Range("A2", wsLog.Cells(wsLog.Rows.Count, "Q").End(xlUp)).Rows
        With RWs
            ky = .Range("Q1") & Format(.Range("A1") + .Range("B1"), "yyyymmddhhmm")
            dictLOG(ky) = dictLOG(ky) + 1
        End With
    Next
    
    Application.ScreenUpdating = False
    
    With Sheets("Result").Range("B21:BCK35")
        'keyの配列を数式で作成する
        .FormulaLocal = "=$A$20&TEXT($A21+B$20,""yyyymmddhhmm"")"
        
        KeyAry = .Value2
        
        For RW = 1 To 15
            For CL = 1 To 1440
                If dictLOG.Exists(KeyAry(RW, CL)) Then
                    ResultAry(RW, CL) = dictLOG(KeyAry(RW, CL))
                End If
            Next CL
        Next RW
        .Value = ResultAry
    End With
    
    Application.ScreenUpdating = True
    dictLOG.RemoveAll
End Sub

投稿日時: 21/01/17 20:26:16
投稿者: うかい

 ありがとうございます。
コピペのまま実行すると「インデックスが有効範囲にありません」と表示されるため、該当箇所である
「With Sheets("Result").Range("B21:BCK35")」の"Result"を表のあるシート名に変更しました。
 
その上で実行するとエラーは出ないのですが、表の中になんの記述もされない状態です。
「ky = .Range("Q1") & Format(.Range("A1") + .Range("B1"), "yyyymmdd")」の
「"yyyymmdd"」を「"20201201"」に変更してみてもカウントの表示はされないままです。
 
どこを変更すれば記述がされるものでしょうか。
コードが理解できておらず、すみません。
 
ちなみに今実行すると(カウントの記述はされませんが)、大体1.7秒程度計測されます。
 
よろしくお願いいたします。

回答
投稿日時: 21/01/17 21:25:39
投稿者: 半平太

シート名を確認してなかったですね。 (-_-;)
「Result」の仮決めで書いちゃいました。
 
>"Result"を表のあるシート名に変更しました。
それでOKです。
 
すみません、「時分」のフォーマットを間違えました。m(__)m
2箇所訂正してください。(分の部分「mm」→「nn」へ)
 
(1) ky = .Range("Q1") & Format(.Range("A1") + .Range("B1"), "yyyymmddhhnn")
 
     'keyの配列を数式で作成する
(2) .FormulaLocal = "=$A$20&TEXT($A21+B$20,""yyyymmddhhnn"")"

回答
投稿日時: 21/01/17 22:24:04
投稿者: 半平太

A21セルは、12/1 とかですが、
実体値は 2020/12/1 と昨年度(2020)のシリアル値になっていますね?

投稿日時: 21/01/17 22:56:48
投稿者: うかい

>実体値は 2020/12/1 と昨年度(2020)のシリアル値になっていますね?
なっております!

回答
投稿日時: 21/01/17 23:45:14
投稿者: 半平太

>        .FormulaLocal = "=$A$20&TEXT($A21+B$20,""yyyymmddhhmm"")"
                         ~~~~~~~~~~~↑~~~~
               こっちは、数式だったので、元の「mm」が正しかった (-_-;)

当方の結果は以下の通りです。
 
<通信履歴ログ サンプル>
 行  _____A_____  __B__  _C_   _P_  __Q__
  1  日付         時分              分類 
  2  2020/12/1    23:58                1 
  3  2020/12/2     8:01                1 
  4  2020/12/3     8:01                1 
  5  2020/12/2    23:59                1 
  6  2020/12/15   23:59                1 
  7  2020/12/2     8:01                1 

<Result 結果図>          
 行  __A________  __B__  __C__  __D__    _RN_  _RO_   _BCI_  _BCJ_  _BCK_
 20    1          0:00   0:01   0:02      8:00  8:01   23:57  23:58  23:59
 21   2020/12/1                                                  1       
 22   2020/12/2                                   2                     1
 23   2020/12/3                                   1                      

回答
投稿日時: 21/01/18 11:36:04
投稿者: Suzu

ピボットテーブルで作ってはいけませんか?
 
レポートとの事ですので、
フォーマットは定型と決まっているとは思うのですが、
データの無い横軸は表示されないので、見やすいかと。。

投稿日時: 21/01/18 22:09:41
投稿者: うかい

半平太さん、ありがとうございます。
結果でました!
実はコードの意味がほとんど分かっていないのですが、これから勉強したいと思います。
お力添えいただき、ありがとうございました。

投稿日時: 21/01/18 22:15:11
投稿者: うかい

>ピボットテーブルで作ってはいけませんか?
私もはじめに思ったのですが、おっしゃる通りフォーマットが決まっているのと(これは転機をすれば解決するかと思いますが)、データのない横軸も表示する必要があるため、そぐわないかな、と感じた次第です。
(例えばデータソースが0:04からカウントされるとしても、項目としては0:00、0:01、0:02…と表示させなければならない)

回答
投稿日時: 21/01/19 00:04:41
投稿者: simple

ピボットテーブルには、そのための機能も付いていますよ。
グループ化と[データのないアイテムを表示する]を組みあわせるとできるようです。
データがない時分もすべてメッシュが作成され、値はブランクになりますね。ご参考まで。

回答
投稿日時: 21/01/19 09:18:28
投稿者: Suzu

simple さんの引用:
ピボットテーブルには、そのための機能も付いていますよ。
グループ化と[データのないアイテムを表示する]を組みあわせるとできるようです。
データがない時分もすべてメッシュが作成され、値はブランクになりますね。ご参考まで。

 
 
グループ化 -
    開始日 0:00
    終了日 23:59
  単位 で 「分」 と 「時」を選ぶ
 
フィールド設定 にて データのないアイテムを表示する
 
ですね。
 
そうすると
 
  列ラベル▼
  <1900/1/0 0時 1時・・・
  <1900/1/0 0分 1分・・・59分 0分 1分・・
 
なるので、列ラベル▼ で
「<1900/1/0」「>1900/1/0」の表示チェックを外すと 近い表にはなりますね!!
こんな機能があったのですね!!
 
勉強になります。
 
0:00 0:01 ・・ に変えようとやってみたけど、やり方が見つかりません。
判ればお願いいします。
 
 
データ最終行以降の時分 に 0:00〜23:59 の値を代入
データソースの変更 を行うくらいしか思いつきません。

回答
投稿日時: 21/01/19 13:33:36
投稿者: simple

ちょっと判らなかったですね。どなたかご存じのかたがおられれば。
 
いずれにしても、既定の書式と全く同一にはできないので、
必要な箇所をコピーペイストするんでしょうか。
# ログ解析なので、どこか役所に提出するわけでもないでしょうから、
# それほどリジッドな書式が定まっているのかなあ、というのが素直な感想です。

トピックに返信