再帰処理にはまる(その2)
vAry = Array(0, 1.1, 4.4, 3.3, 2.2) という配列があった時、
何組かの同じ配列を使って総当たりで、たし算しましょう。
その結果、重複する数値は排除して小さい順に表示しましょう。
例えば、
A = Array(0, 1.1, 4.4, 3.3, 2.2)
B = Array(0, 1.1, 4.4, 3.3, 2.2)
C = Array(0, 1.1, 4.4, 3.3, 2.2)
の3つを使って、
A(0)+B(0)+C(0)= や A(0)+B(0)+C(1)= や A(0)+B(0)+C(2)= ・・・・・
A(0)+B(1)+C(0)= や A(0)+B(1)+C(1)= や A(0)+B(1)+C(2)= ・・・・・
・・・・
A(4)+B(3)+C(0)= や A(4)+B(3)+C(1)= や A(4)+B(3)+C(2)= ・・・・・
A(4)+B(4)+C(0)= や A(4)+B(4)+C(1)= や A(4)+B(4)+C(2)= ・・・・・
の結果、重複を排除して小さい順に
0
1.1
2.2
3.3
4.4
5.5
6.6
7.7
8.8
9.9
11
12.1
13.2
と
何組かの同じ配列を使って総当たりで、たし算しましょう。
その結果、重複する数値は排除して小さい順に表示しましょう。
例えば、
A = Array(0, 1.1, 4.4, 3.3, 2.2)
B = Array(0, 1.1, 4.4, 3.3, 2.2)
C = Array(0, 1.1, 4.4, 3.3, 2.2)
の3つを使って、
A(0)+B(0)+C(0)= や A(0)+B(0)+C(1)= や A(0)+B(0)+C(2)= ・・・・・
A(0)+B(1)+C(0)= や A(0)+B(1)+C(1)= や A(0)+B(1)+C(2)= ・・・・・
・・・・
A(4)+B(3)+C(0)= や A(4)+B(3)+C(1)= や A(4)+B(3)+C(2)= ・・・・・
A(4)+B(4)+C(0)= や A(4)+B(4)+C(1)= や A(4)+B(4)+C(2)= ・・・・・
の結果、重複を排除して小さい順に
0
1.1
2.2
3.3
4.4
5.5
6.6
7.7
8.8
9.9
11
12.1
13.2
と
サンプルファイルは 再帰処理にはまる(その1) にあります
再帰処理にはまる(その3) も読んでいただければと
1)ベタで考える【標準モジュール:Pat2n】
1-1)総当たりの結果を格納する配列を用意する
まず、対象を配列で作成したら、計算誤差をなくすために CCur 変換しておきます。
何組使ってやるかは iCount で指定するように
基本の配列を1組分作っておきます。
次の組を処理する際、全ての結果を格納できるように領域を確保して総当たり計算
これを必要な組分繰り返します。
その後、重複分の値を排除する為に Dictionary を使用します。
値をキーとして利用することで、重複を排除できます。
排除後のキーを取得して、昇順に並び変えて表示します。
Public Sub Sample1()
Dim vAry As Variant
Dim vBase As Variant
Dim vTmp As Variant
Dim dic As Object
Dim i As Long, jB As Long, jA As Long, k As Long
Const iCount As Long = 3
vAry = Array(0, 1.1, 4.4, 3.3, 2.2)
' vAry = Array(0, 9.9, 1.1, 8.8, 2.2, 7.7, 3.3, 6.6, 4.4, 5.5)
For i = 0 To UBound(vAry)
vAry(i) = CCur(vAry(i))
Next
vBase = vAry
For i = 2 To iCount
ReDim vTmp((UBound(vBase) + 1) * (UBound(vAry) + 1) - 1)
k = 0
For jB = 0 To UBound(vBase)
For jA = 0 To UBound(vAry)
vTmp(k) = vBase(jB) + vAry(jA)
k = k + 1
Next
Next
vBase = vTmp
vTmp = Empty
Next
Set dic = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(vBase)
dic.Item(vBase(i)) = Null
Next
vBase = dic.keys
Set dic = Nothing
For i = 0 To UBound(vBase) - 1
For k = i + 1 To UBound(vBase)
If (vBase(k) < vBase(i)) Then
vTmp = vBase(i)
vBase(i) = vBase(k)
vBase(k) = vTmp
End If
Next
Next
For i = 0 To UBound(vBase)
Debug.Print vBase(i)
Next
End Sub
Dim vAry As Variant
Dim vBase As Variant
Dim vTmp As Variant
Dim dic As Object
Dim i As Long, jB As Long, jA As Long, k As Long
Const iCount As Long = 3
vAry = Array(0, 1.1, 4.4, 3.3, 2.2)
' vAry = Array(0, 9.9, 1.1, 8.8, 2.2, 7.7, 3.3, 6.6, 4.4, 5.5)
For i = 0 To UBound(vAry)
vAry(i) = CCur(vAry(i))
Next
vBase = vAry
For i = 2 To iCount
ReDim vTmp((UBound(vBase) + 1) * (UBound(vAry) + 1) - 1)
k = 0
For jB = 0 To UBound(vBase)
For jA = 0 To UBound(vAry)
vTmp(k) = vBase(jB) + vAry(jA)
k = k + 1
Next
Next
vBase = vTmp
vTmp = Empty
Next
Set dic = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(vBase)
dic.Item(vBase(i)) = Null
Next
vBase = dic.keys
Set dic = Nothing
For i = 0 To UBound(vBase) - 1
For k = i + 1 To UBound(vBase)
If (vBase(k) < vBase(i)) Then
vTmp = vBase(i)
vBase(i) = vBase(k)
vBase(k) = vTmp
End If
Next
Next
For i = 0 To UBound(vBase)
Debug.Print vBase(i)
Next
End Sub
組数が多くなってくると、全計算結果を格納する領域の確保が問題になってくると思います。
そこで、2組目、3組目と処理をしていく中で、重複を排除した結果だけを覚えておきましょう。
その結果と、次の組を総当たりで・・・・・この時も重複は排除しておきましょう。
それが次の例となります。
1-2)計算結果のみを Dictionary で管理
Public Sub Sample2()
Dim vAry As Variant
Dim vBase As Variant
Dim vTmp As Variant
Dim dic As Object
Dim i As Long, j As Long
Const iCount As Long = 3
vAry = Array(0, 1.1, 4.4, 3.3, 2.2)
' vAry = Array(0, 9.9, 1.1, 8.8, 2.2, 7.7, 3.3, 6.6, 4.4, 5.5)
Set dic = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(vAry)
vAry(i) = CCur(vAry(i))
dic.Item(vAry(i)) = Null
Next
For i = 2 To iCount
vBase = dic.keys
dic.RemoveAll
For Each vTmp In vBase
For j = 0 To UBound(vAry)
dic.Item(vTmp + vAry(j)) = Null
Next
Next
Next
vBase = dic.keys
Set dic = Nothing
For i = 0 To UBound(vBase) - 1
For j = i + 1 To UBound(vBase)
If (vBase(j) < vBase(i)) Then
vTmp = vBase(i)
vBase(i) = vBase(j)
vBase(j) = vTmp
End If
Next
Next
For i = 0 To UBound(vBase)
Debug.Print vBase(i)
Next
End Sub
Dim vAry As Variant
Dim vBase As Variant
Dim vTmp As Variant
Dim dic As Object
Dim i As Long, j As Long
Const iCount As Long = 3
vAry = Array(0, 1.1, 4.4, 3.3, 2.2)
' vAry = Array(0, 9.9, 1.1, 8.8, 2.2, 7.7, 3.3, 6.6, 4.4, 5.5)
Set dic = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(vAry)
vAry(i) = CCur(vAry(i))
dic.Item(vAry(i)) = Null
Next
For i = 2 To iCount
vBase = dic.keys
dic.RemoveAll
For Each vTmp In vBase
For j = 0 To UBound(vAry)
dic.Item(vTmp + vAry(j)) = Null
Next
Next
Next
vBase = dic.keys
Set dic = Nothing
For i = 0 To UBound(vBase) - 1
For j = i + 1 To UBound(vBase)
If (vBase(j) < vBase(i)) Then
vTmp = vBase(i)
vBase(i) = vBase(j)
vBase(j) = vTmp
End If
Next
Next
For i = 0 To UBound(vBase)
Debug.Print vBase(i)
Next
End Sub
組数が多くなってくると、この方法が一番良いようです。
VBA記述での例にはなりませんが、せっかく Access を使っているので、
テーブルを用意して、クエリで直積を利用して・・・このクエリを作れるように
作られるクエリは
SELECT DISTINCT (Q1.値+Q2.値+Q3.値) AS 値
FROM T1 AS Q1, T1 AS Q2, T1 AS Q3;
てな感じになります。FROM T1 AS Q1, T1 AS Q2, T1 AS Q3;
また、クエリを手動/VBA で作成した時のプロパティの違いも確認したいかなっていうレベルで以下
(テーブルは「T1」として用意しています)
Public Sub DataMakeT1()
Dim vAry As Variant
Dim i As Long
vAry = Array(0, 1.1, 4.4, 3.3, 2.2)
' vAry = Array(0, 9.9, 1.1, 8.8, 2.2, 7.7, 3.3, 6.6, 4.4, 5.5)
For i = 0 To UBound(vAry)
vAry(i) = CCur(vAry(i))
Next
With CurrentDb
.Execute "DELETE * FROM T1;"
With .OpenRecordset("T1")
For i = 0 To UBound(vAry)
.AddNew
.Fields("値") = vAry(i)
.Update
Next
.Close
End With
End With
End Sub
Public Sub QueryMakeQ_T1()
Dim sSql As String
Dim sS As String
Dim i As Long
Const sQuery As String = "Q_T1"
Const iCount As Long = 3
sSql = ""
sS = ""
For i = 1 To iCount
sSql = sSql & "+Q" & i & ".値"
sS = sS & ", T1 AS Q" & i
Next
sSql = "(" & Mid(sSql, 2) & ") AS 値"
sS = Mid(sS, 3)
sSql = "SELECT DISTINCT " & sSql & " FROM " & sS & ";"
On Error Resume Next
DoCmd.Close acQuery, sQuery, acSaveNo
With CurrentDb
.QueryDefs.Delete sQuery
.CreateQueryDef sQuery, sSql
.QueryDefs.Refresh
With .QueryDefs(sQuery).Fields("値")
.Properties.Append .CreateProperty("Format", dbText, "General Number")
.Properties.Append .CreateProperty("DecimalPlaces", dbByte, 4)
End With
End With
DoCmd.OpenQuery sQuery
End Sub
Public Sub ChkPrp()
Dim prp As DAO.Property
Const sQuery As String = "Q_T1"
On Error Resume Next
With CurrentDb
With .QueryDefs(sQuery).Fields("値")
For Each prp In .Properties
Debug.Print prp.Name,
Debug.Print prp.Type,
Debug.Print prp.Value,
Debug.Print ""
Next
End With
End With
End Sub
Dim vAry As Variant
Dim i As Long
vAry = Array(0, 1.1, 4.4, 3.3, 2.2)
' vAry = Array(0, 9.9, 1.1, 8.8, 2.2, 7.7, 3.3, 6.6, 4.4, 5.5)
For i = 0 To UBound(vAry)
vAry(i) = CCur(vAry(i))
Next
With CurrentDb
.Execute "DELETE * FROM T1;"
With .OpenRecordset("T1")
For i = 0 To UBound(vAry)
.AddNew
.Fields("値") = vAry(i)
.Update
Next
.Close
End With
End With
End Sub
Public Sub QueryMakeQ_T1()
Dim sSql As String
Dim sS As String
Dim i As Long
Const sQuery As String = "Q_T1"
Const iCount As Long = 3
sSql = ""
sS = ""
For i = 1 To iCount
sSql = sSql & "+Q" & i & ".値"
sS = sS & ", T1 AS Q" & i
Next
sSql = "(" & Mid(sSql, 2) & ") AS 値"
sS = Mid(sS, 3)
sSql = "SELECT DISTINCT " & sSql & " FROM " & sS & ";"
On Error Resume Next
DoCmd.Close acQuery, sQuery, acSaveNo
With CurrentDb
.QueryDefs.Delete sQuery
.CreateQueryDef sQuery, sSql
.QueryDefs.Refresh
With .QueryDefs(sQuery).Fields("値")
.Properties.Append .CreateProperty("Format", dbText, "General Number")
.Properties.Append .CreateProperty("DecimalPlaces", dbByte, 4)
End With
End With
DoCmd.OpenQuery sQuery
End Sub
Public Sub ChkPrp()
Dim prp As DAO.Property
Const sQuery As String = "Q_T1"
On Error Resume Next
With CurrentDb
With .QueryDefs(sQuery).Fields("値")
For Each prp In .Properties
Debug.Print prp.Name,
Debug.Print prp.Type,
Debug.Print prp.Value,
Debug.Print ""
Next
End With
End With
End Sub
2)再帰処理で考える【標準モジュール:Pat2r】
2-1)重複結果を Dictionary のキーで管理
総当たりする部分を再帰処理にします。
計算結果を Dictionary のキーとして利用し重複を排除します。
Dim dic As Object
Private Sub ReCallCurAdd(iNst As Long, vAry As Variant, cSrc As Currency)
Dim v As Variant
Dim c As Currency
For Each v In vAry
c = cSrc + v
If (iNst <= 1) Then
dic.Item(c) = Null
Else
Call ReCallCurAdd(iNst - 1, vAry, c)
End If
Next
End Sub
Public Sub Sample1()
Dim vAry As Variant
Dim vBase As Variant
Dim vTmp As Variant
Dim i As Long, jB As Long, jA As Long, k As Long
Const iCount As Long = 3
vAry = Array(0, 1.1, 4.4, 3.3, 2.2)
' vAry = Array(0, 9.9, 1.1, 8.8, 2.2, 7.7, 3.3, 6.6, 4.4, 5.5)
For i = 0 To UBound(vAry)
vAry(i) = CCur(vAry(i))
Next
Set dic = CreateObject("Scripting.Dictionary")
Call ReCallCurAdd(iCount, vAry, 0)
vBase = dic.keys
Set dic = Nothing
For i = 0 To UBound(vBase) - 1
For k = i + 1 To UBound(vBase)
If (vBase(k) < vBase(i)) Then
vTmp = vBase(i)
vBase(i) = vBase(k)
vBase(k) = vTmp
End If
Next
Next
For i = 0 To UBound(vBase)
Debug.Print vBase(i)
Next
End Sub
Private Sub ReCallCurAdd(iNst As Long, vAry As Variant, cSrc As Currency)
Dim v As Variant
Dim c As Currency
For Each v In vAry
c = cSrc + v
If (iNst <= 1) Then
dic.Item(c) = Null
Else
Call ReCallCurAdd(iNst - 1, vAry, c)
End If
Next
End Sub
Public Sub Sample1()
Dim vAry As Variant
Dim vBase As Variant
Dim vTmp As Variant
Dim i As Long, jB As Long, jA As Long, k As Long
Const iCount As Long = 3
vAry = Array(0, 1.1, 4.4, 3.3, 2.2)
' vAry = Array(0, 9.9, 1.1, 8.8, 2.2, 7.7, 3.3, 6.6, 4.4, 5.5)
For i = 0 To UBound(vAry)
vAry(i) = CCur(vAry(i))
Next
Set dic = CreateObject("Scripting.Dictionary")
Call ReCallCurAdd(iCount, vAry, 0)
vBase = dic.keys
Set dic = Nothing
For i = 0 To UBound(vBase) - 1
For k = i + 1 To UBound(vBase)
If (vBase(k) < vBase(i)) Then
vTmp = vBase(i)
vBase(i) = vBase(k)
vBase(k) = vTmp
End If
Next
Next
For i = 0 To UBound(vBase)
Debug.Print vBase(i)
Next
End Sub
2-2)重複しない結果を都度整列生成
基本的には2-1)と同じですが、Dictionary 部分の使い方が変わってきます。
重複しない結果が得られたら・・・・・
これ、Dictionary に設定する時に管理している個数に変化があったかで判別しています。
変化あったら重複しない値だった・・・・なので、自分で都度昇順に格納していきます。
Dim dic As Object
Dim cAry As Variant ' Sample2 で使用
Private Sub CurAdd2(cSrc As Currency)
Dim i As Long
Dim j As Long
If (IsEmpty(cAry)) Then
ReDim cAry(0)
cAry(0) = cSrc
Else
For i = 0 To UBound(cAry)
If (cAry(i) > cSrc) Then
ReDim Preserve cAry(UBound(cAry) + 1)
For j = UBound(cAry) - 1 To i Step -1
cAry(j + 1) = cAry(j)
Next
cAry(i) = cSrc
Exit For
End If
Next
If (i > UBound(cAry)) Then
ReDim Preserve cAry(i)
cAry(i) = cSrc
End If
End If
End Sub
Private Sub ReCallCurAdd2(iNst As Long, vAry As Variant, cSrc As Currency)
Dim v As Variant
Dim c As Currency
Dim i As Long
For Each v In vAry
c = cSrc + v
If (iNst <= 1) Then
i = dic.Count
dic.Item(c) = Null
If (dic.Count <> i) Then Call CurAdd2(c)
Else
Call ReCallCurAdd2(iNst - 1, vAry, c)
End If
Next
End Sub
Public Sub Sample2()
Dim vAry As Variant
Dim i As Long
Const iCount As Long = 3
vAry = Array(0, 1.1, 4.4, 3.3, 2.2)
' vAry = Array(0, 9.9, 1.1, 8.8, 2.2, 7.7, 3.3, 6.6, 4.4, 5.5)
For i = 0 To UBound(vAry)
vAry(i) = CCur(vAry(i))
Next
cAry = Empty
Set dic = CreateObject("Scripting.Dictionary")
Call ReCallCurAdd2(iCount, vAry, 0)
Set dic = Nothing
For i = 0 To UBound(cAry)
Debug.Print cAry(i)
Next
End Sub
Dim cAry As Variant ' Sample2 で使用
Private Sub CurAdd2(cSrc As Currency)
Dim i As Long
Dim j As Long
If (IsEmpty(cAry)) Then
ReDim cAry(0)
cAry(0) = cSrc
Else
For i = 0 To UBound(cAry)
If (cAry(i) > cSrc) Then
ReDim Preserve cAry(UBound(cAry) + 1)
For j = UBound(cAry) - 1 To i Step -1
cAry(j + 1) = cAry(j)
Next
cAry(i) = cSrc
Exit For
End If
Next
If (i > UBound(cAry)) Then
ReDim Preserve cAry(i)
cAry(i) = cSrc
End If
End If
End Sub
Private Sub ReCallCurAdd2(iNst As Long, vAry As Variant, cSrc As Currency)
Dim v As Variant
Dim c As Currency
Dim i As Long
For Each v In vAry
c = cSrc + v
If (iNst <= 1) Then
i = dic.Count
dic.Item(c) = Null
If (dic.Count <> i) Then Call CurAdd2(c)
Else
Call ReCallCurAdd2(iNst - 1, vAry, c)
End If
Next
End Sub
Public Sub Sample2()
Dim vAry As Variant
Dim i As Long
Const iCount As Long = 3
vAry = Array(0, 1.1, 4.4, 3.3, 2.2)
' vAry = Array(0, 9.9, 1.1, 8.8, 2.2, 7.7, 3.3, 6.6, 4.4, 5.5)
For i = 0 To UBound(vAry)
vAry(i) = CCur(vAry(i))
Next
cAry = Empty
Set dic = CreateObject("Scripting.Dictionary")
Call ReCallCurAdd2(iCount, vAry, 0)
Set dic = Nothing
For i = 0 To UBound(cAry)
Debug.Print cAry(i)
Next
End Sub
2-3)重複しない組み合わせを事前に求める
今回は足し算でそう時間がかかるものではありませんが、考え方として・・・・
総当たりで計算するのではなく、計算が必要なケースを探します。
この時再帰処理を使用します。
元の配列数と同じ中身 0 の変数を用意し、どのケースがあるか調べます。
このケースの管理に Dictionary を使用します。
Dictionary に格納される内容としては、"0,3;1,0;2,0;3,0;4,0" のような文字列になります。
これは、
A(0)+B(0)+C(1)= や A(0)+B(1)+C(0)= や A(1)+B(0)+C(0)=
これら全て計算する必要はなく (0) を2回、(1) を1回のケースですね・・・・
この場合、"0,2;1,1;2,0;3,0;4,0" とするルールを決めました。
";" 区切りで、その中を "," で区切って (0) が配列参照の添え字に、(1) が回数に
(実際に必要な "0,2;1,1" だけの方が良かったのかも・・・・)
必要なケースだけやったとしても、計算結果が重複しない保証はないので、
また Dictionary を使って重複排除
Dim dic As Object
Private Sub ReCallMake3(iNst As Long, vAry As Variant)
Dim i As Long, j As Long
Dim sS As String
Dim vWrkAry As Variant
For i = 0 To UBound(vAry)
vWrkAry = vAry
vWrkAry(i) = vWrkAry(i) + 1
If (iNst <= 1) Then
sS = ""
For j = 0 To UBound(vWrkAry)
sS = sS & ";" & j & "," & vWrkAry(j)
Next
dic.Item(Mid(sS, 2)) = Null
Else
Call ReCallMake3(iNst - 1, vWrkAry)
End If
Next
End Sub
Public Sub Sample3()
Dim vAry As Variant
Dim vWrkAry As Variant
Dim vBase As Variant
Dim vTmp As Variant
Dim i As Long, j As Long
Dim vKs As Variant, vK As Variant
Dim vAs As Variant, vA As Variant
Dim c As Currency, cW As Currency
Const iCount As Long = 3
vAry = Array(0, 1.1, 4.4, 3.3, 2.2)
' vAry = Array(0, 9.9, 1.1, 8.8, 2.2, 7.7, 3.3, 6.6, 4.4, 5.5)
vWrkAry = vAry
For i = 0 To UBound(vWrkAry)
vWrkAry(i) = 0
Next
Set dic = CreateObject("Scripting.Dictionary")
Call ReCallMake3(iCount, vWrkAry)
vKs = dic.keys
dic.RemoveAll
For Each vK In vKs
c = 0
For Each vAs In Split(vK, ";")
vA = Split(vAs, ",")
cW = vAry(CLng(vA(0)))
For i = 1 To CLng(vA(1))
c = c + cW
Next
Next
dic.Item(c) = Null
Next
vBase = dic.keys
Set dic = Nothing
For i = 0 To UBound(vBase) - 1
For j = i + 1 To UBound(vBase)
If (vBase(j) < vBase(i)) Then
vTmp = vBase(i)
vBase(i) = vBase(j)
vBase(j) = vTmp
End If
Next
Next
For i = 0 To UBound(vBase)
Debug.Print vBase(i)
Next
End Sub
Private Sub ReCallMake3(iNst As Long, vAry As Variant)
Dim i As Long, j As Long
Dim sS As String
Dim vWrkAry As Variant
For i = 0 To UBound(vAry)
vWrkAry = vAry
vWrkAry(i) = vWrkAry(i) + 1
If (iNst <= 1) Then
sS = ""
For j = 0 To UBound(vWrkAry)
sS = sS & ";" & j & "," & vWrkAry(j)
Next
dic.Item(Mid(sS, 2)) = Null
Else
Call ReCallMake3(iNst - 1, vWrkAry)
End If
Next
End Sub
Public Sub Sample3()
Dim vAry As Variant
Dim vWrkAry As Variant
Dim vBase As Variant
Dim vTmp As Variant
Dim i As Long, j As Long
Dim vKs As Variant, vK As Variant
Dim vAs As Variant, vA As Variant
Dim c As Currency, cW As Currency
Const iCount As Long = 3
vAry = Array(0, 1.1, 4.4, 3.3, 2.2)
' vAry = Array(0, 9.9, 1.1, 8.8, 2.2, 7.7, 3.3, 6.6, 4.4, 5.5)
vWrkAry = vAry
For i = 0 To UBound(vWrkAry)
vWrkAry(i) = 0
Next
Set dic = CreateObject("Scripting.Dictionary")
Call ReCallMake3(iCount, vWrkAry)
vKs = dic.keys
dic.RemoveAll
For Each vK In vKs
c = 0
For Each vAs In Split(vK, ";")
vA = Split(vAs, ",")
cW = vAry(CLng(vA(0)))
For i = 1 To CLng(vA(1))
c = c + cW
Next
Next
dic.Item(c) = Null
Next
vBase = dic.keys
Set dic = Nothing
For i = 0 To UBound(vBase) - 1
For j = i + 1 To UBound(vBase)
If (vBase(j) < vBase(i)) Then
vTmp = vBase(i)
vBase(i) = vBase(j)
vBase(j) = vTmp
End If
Next
Next
For i = 0 To UBound(vBase)
Debug.Print vBase(i)
Next
End Sub
5、6組ぐらいまでなら再帰も使えるかも・・・・・
それ以上だと・・・・・・・・・
この処理では、1-2)が格段に速い、良いですね。
50組でもソコソコの応答があるし・・・・・
- 関連記事
-
- 連番の空き先頭を探す (2013/09/13)
- 自前スクロールバー (2011/12/07)
- Excel VBA をやってみた その3(合計値検索) (2012/04/25)
- 奥が深い (2014/08/31)
- 再帰処理にはまる(その2) (2012/03/12)
- 再帰処理にはまる(その4 乾杯!!) (2012/04/20)
- フィールド順 クエリ編 (2011/06/04)
- 帳票 + 3つのコンボ変則連携 + α (2013/05/05)
- 重ねる (2012/05/16)
- Dictionary をダンダン (2013/08/17)
- Form_Delete 以降のイベント (2012/03/31)
- Excel VBA をやってみた その12 (2014/09/27)
- 再帰処理にはまる(その5) (2013/05/06)
2012/03/12
Category: やってみる
« 再帰処理にはまる(その3)
再帰処理にはまる(その1) »
この記事に対するコメント
トラックバック
| h o m e |