
こんばんは。
下記の式を高速化させたいのですが、どうすればよいのか分からないため質問させていただきます。
Sub 全組み合わせ個数()
Dim XX As Long '計算結果を出力する行数
Dim a1 As Long '組み合わせ
Dim a2 As Long
Dim a3 As Long
Dim a4 As Long
Dim aa1 As Long '昇順にした後の組み合わせ
Dim aa2 As Long
Dim aa3 As Long
Dim aa4 As Long
Dim SS As Long
Dim CBN As Long
Dim I As Long
Dim Cnt As Long
Dim CntClm As Long 'COUNTIFSの列数
Dim CntClm1 As Long 'CntClm - 1 した列数
XX = 50 '表が40数行目まであるため50行目以降に計算結果を出力
For a1 = 2 To 43
For a2 = 2 To 43
For a3 = 2 To 43
For a4 = 2 To 43
Range(Cells(50, 2), Cells(50, 2)) = a1
Range(Cells(50, 3), Cells(50, 3)) = a2
Range(Cells(50, 4), Cells(50, 4)) = a3
Range(Cells(50, 5), Cells(50, 5)) = a4
'昇順に並び替え
With ActiveSheet
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range(Cells(50, 2), Cells(50, 5)), Order:=xlAscending
.Sort.SetRange .Range(Cells(50, 2), Cells(50, 5))
.Sort.Orientation = xlSortRows
.Sort.Apply
End With
aa1 = Range(Cells(50, 2), Cells(50, 2))
aa2 = Range(Cells(50, 3), Cells(50, 3))
aa3 = Range(Cells(50, 4), Cells(50, 4))
aa4 = Range(Cells(50, 5), Cells(50, 5))
'当組み合わせの中で数字が重複している場合に除外
SS = 0
If aa1 = aa2 Then
SS = 1
ElseIf aa2 = aa3 Then
SS = 1
ElseIf aa3 = aa4 Then
SS = 1
Else
SS = 0
End If
'他の組み合わせと当組み合わせの数字が同じ場合に除外
If SS = 0 Then
CBN = aa1 & aa2 & aa3 & aa4
For I = 50 To XX
If Range(Cells(I, 1), Cells(I, 1)) = CBN Then
SS = 1
Else
End If
Next I
End If
If SS = 0 Then
'重複がない組み合わせを1列目に記入
XX = XX + 1
CBN = aa1 & aa2 & aa3 & aa4
Range(Cells(XX, 1), Cells(XX, 1)) = CBN
'その組み合わせの数を行数としてCOUNTIFSの数式に使う
For CntClm = 6 To 1743
CntClm1 = CntClm - 1
Cnt = WorksheetFunction.CountIfs(Range(Cells(aa1, 5), Cells(aa1, CntClm1)), Cells(aa1, CntClm), _
Range(Cells(aa2, 5), Cells(aa2, CntClm1)), Cells(aa2, CntClm), _
Range(Cells(aa3, 5), Cells(aa3, CntClm1)), Cells(aa3, CntClm), _
Range(Cells(aa4, 5), Cells(aa4, CntClm1)), Cells(aa4, CntClm), _
Range(Cells(44, 5), Cells(44, CntClm1)), Cells(44, CntClm), _
Range(Cells(45, 5), Cells(45, CntClm1)), "正")
Cells(XX, CntClm) = Cnt
Next CntClm
End If
Next a4
Next a3
Next a2
Next a1
End Sub
上記の数式はこちらのサイトから全組み合わせの算出方法を真似させて頂き(https://rikei-logistics.com/count-by-macro)、算出した数字を行数に見立ててCOUNTIFSでカウントしたものです。
※コメントは私が書いたため、製作者様の数式の意図と違う可能性があります。
組み合わせの総数が10万通り以上になるため元の表の時間軸を横にしており、そこから43C4通りのデータを1737日分算出しています。
ただ上記の式では1通りの1737日分の計算に1秒弱かかるため、単純計算でも1日以上かかってしまいます。
そのため何か処理を高速化できる方法があれば教えて頂きたいと思い、質問させて頂きました。
一応COUNTIFS単体であればDictionaryによって高速化できるようなのですが、上記の数式で再現できるか分かりませんでした。(掲載サイト:https://officedic.com/excel-vba-countifs-dic/)
お手数ですがご回答頂けますと大変助かります。
A 回答 (4件)
- 最新から表示
- 回答順に表示
No.4
- 回答日時:
こんにちは
何をなさりたいのか記載がないので、さっぱりわかりませんけれど・・
(コードを見せられても、本当は、何をしたいのかを推測するのは面倒なので・・)
プロシージャ名を見ると
>Sub 全組み合わせ個数()
となっているので、「組み合わせの個数」を求めたいってことでしょうか?
であるなら、いちいち組み合わせを作らなくても、いわゆる C (=組み合わせ)の計算で直接求めるのが簡単かと。
どうやら数値を連結しているようなので、
①12、②34、③123、④4
の異なる数字がある時に、
①&② ・・・1234
と
③&④ ・・・1234
のような結果の重複も省きたいという場合には、かなり面倒になりそうですけれど・・
>そのため何か処理を高速化できる方法があれば教えて頂きたいと思い~
何を計算したいのかわかりませんけれど、まずは、ロジックを見直すのが一番の改善策ではないかと想像します。
VBAはもともと速くはありませんが、セルへのアクセス(=読み書き)には時間がかかります。
いちいちセルに記入して計算する方法ではなく、メモリ上(=変数)で計算するように変更するだけでも、格段に速くなるものと考えられます。
(Sortや重複の排除などには、シートの計算を利用するのもありと思いますが・・こちらも頻度によります)
No.3
- 回答日時:
エクセルは都度、値を描画するために速度が遅くなります。
先頭で描画停止し、終了前に再開したどうですか。
Application.ScreenUpdating = False ' 描画を停止
Application.ScreenUpdating = True ' 描画を再開
セルの出し入れをするのも遅い理由です。
上で改善しない場合は、セルを一旦配列に移し、配列内で処理してセルに戻す様にしたら良いと思います。
ただし、セルには1回しか出し入れしないので有れば、配列にするだけ時間が無駄になるので止めです。
No.1
- 回答日時:
画面を止める
http://officetanaka.net/excel/vba/speed/s1.htm
まず基本としては画面(セルへの書き出しや並び替え)更新を一時的に停止させ最終結果のみ表示されるようにしてみるとか。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
このQ&Aを見た人はこんなQ&Aも見ています
-
プロが教えるわが家の防犯対策術!
ホームセキュリティのプロが、家庭の防犯対策を真剣に考える 2組のご夫婦へ実際の防犯対策術をご紹介!どうすれば家と家族を守れるのかを教えます!
-
VBAで、特定の文字より後を削除して残った数値を文字列に変換と特定の文字より前も削除したい
Visual Basic(VBA)
-
Dictionaryを使い4つの条件の一致で2つの集計列を集計したいのです
Visual Basic(VBA)
-
EXCEL VBA Dictionaryで複数の値を格納→離れた位置に出力する方法
Excel(エクセル)
-
4
もしセルが#N/A"なら~をする・・・には?"
Excel(エクセル)
-
5
VBAで複数のブックを開かずに処理する方法
Visual Basic(VBA)
-
6
VBAで文字列を数値に変換したい
Excel(エクセル)
-
7
【Excel】【VBA】空白のセルに上のデータを入力する方法
その他(Microsoft Office)
-
8
エクセルVBA 配列からセルに「関数式」を一気代入したい
Visual Basic(VBA)
-
9
UserForm1.Showでエラーになります。
工学
-
10
エクセルVBA SUMIFSの高速化
Excel(エクセル)
-
11
VBAで保存しないで閉じると空のBookが残る
Excel(エクセル)
-
12
VBA別シートの最終行の次行へ転記したい。
Visual Basic(VBA)
-
13
【VBA】指定した検索条件に一致したら別シートに転記したい
Visual Basic(VBA)
-
14
VBA 別ブックからの転記の高速化について VBA 別ブックからの転記の高速化についてご教授下さい。
Visual Basic(VBA)
-
15
エクセルVBAのIf,Then 構文でOr条件とAnd条件の結合方法?
Excel(エクセル)
-
16
エクセルのエラーメッセージ「400」って?
Visual Basic(VBA)
-
17
エクセルVBAで、条件に一致するセルへ移動
Excel(エクセル)
-
18
WorkBooksをオープンさせずにシートにコピーしたい【EXCEL VBA】
Excel(エクセル)
-
19
matchプロパティを取得できません…と出ます。
PowerPoint(パワーポイント)
-
20
【Excel】 SUMPRODUCT関数の高速化
Excel(エクセル)
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
このカテゴリの人気Q&Aランキング
-
4
エクセルでマウスカーソルの形...
-
5
セル入力文字が、「右のセルに...
-
6
(Excel)あるセルに文字を入力...
-
7
エクセルで、変な矢印がでて、...
-
8
エクセルの2ページ目の作り方
-
9
EXCELで2列を参照し、重複する...
-
10
【Excel関数】UNIQUE関数で"0"...
-
11
再質問 エクセル「社員の重なっ...
-
12
Excel 書式を関数で判断。
-
13
関数を使わずに一括で全角を半...
-
14
エクセルのセル内の余白の設定...
-
15
エクセルで作った新しいウイン...
-
16
エクセル: セルの枠を超えて表示
-
17
グラフの横・縦項目が全部表示...
-
18
Excel に貼り付けた図形が、保...
-
19
エクセルでアルファベットか数...
-
20
AとBを比べて、小さいほうの値...
おすすめ情報
公式facebook
公式twitter