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

こんばんは。
下記の式を高速化させたいのですが、どうすればよいのか分からないため質問させていただきます。

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件)

こんにちは



何をなさりたいのか記載がないので、さっぱりわかりませんけれど・・
(コードを見せられても、本当は、何をしたいのかを推測するのは面倒なので・・)

プロシージャ名を見ると
>Sub 全組み合わせ個数()
となっているので、「組み合わせの個数」を求めたいってことでしょうか?

であるなら、いちいち組み合わせを作らなくても、いわゆる C (=組み合わせ)の計算で直接求めるのが簡単かと。
どうやら数値を連結しているようなので、
 ①12、②34、③123、④4
の異なる数字がある時に、
 ①&② ・・・1234

 ③&④ ・・・1234
のような結果の重複も省きたいという場合には、かなり面倒になりそうですけれど・・


>そのため何か処理を高速化できる方法があれば教えて頂きたいと思い~
何を計算したいのかわかりませんけれど、まずは、ロジックを見直すのが一番の改善策ではないかと想像します。

VBAはもともと速くはありませんが、セルへのアクセス(=読み書き)には時間がかかります。
いちいちセルに記入して計算する方法ではなく、メモリ上(=変数)で計算するように変更するだけでも、格段に速くなるものと考えられます。
(Sortや重複の排除などには、シートの計算を利用するのもありと思いますが・・こちらも頻度によります)
    • good
    • 1

エクセルは都度、値を描画するために速度が遅くなります。



先頭で描画停止し、終了前に再開したどうですか。

Application.ScreenUpdating = False ' 描画を停止
Application.ScreenUpdating = True ' 描画を再開

セルの出し入れをするのも遅い理由です。
上で改善しない場合は、セルを一旦配列に移し、配列内で処理してセルに戻す様にしたら良いと思います。
ただし、セルには1回しか出し入れしないので有れば、配列にするだけ時間が無駄になるので止めです。
    • good
    • 0

あとは



https://excel-ubara.com/excelvba5/EXCELVBA264.html

こちらなのかな?
    • good
    • 0

画面を止める


http://officetanaka.net/excel/vba/speed/s1.htm

まず基本としては画面(セルへの書き出しや並び替え)更新を一時的に停止させ最終結果のみ表示されるようにしてみるとか。
    • good
    • 0

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

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


このカテゴリの人気Q&Aランキング