VBA Evaluateはアクティブセル向け?
度々、お世話になります
Evaluateなのですが
対象シートを、最前面に
出して、おかないと
駄目
とは、
聞いた事が、ない
の、ですが
出して、おかないと
ダメ
なのですか?
下記コードは
以前、頂いたものに
加筆した、もの
ですが
動かして、みると
なんか、変です
一定条件下で
☆印の、所の
ストップに、引っかかります
条件とは
visibleを、FALSに
すると
当然の、如く
ダメだし
それどころか、アクティブに
しておかないと
どうやら
正しく、計算しなかった
のです
また、何か
私、しでかしている
で、しょうか?
お教えください
記
Option Explicit
Option Base 0
Dim Ch As Long, s1 As Long, s2 As Long, Data(100, 100) As Long, Ws As Worksheet
Dim dummy, i As Long, j As Long, t(8) As Long, 項試験回数 As Long
Sub testMain() ' 簡易テスト
Dim 現状保存 As Worksheet, シート名 As String
Let シート名 = ActiveSheet.Name
Application.ScreenUpdating = False
Set Ws = Worksheets.Add()
Worksheets(シート名).Copy after:=Worksheets(Worksheets.Count)
Set 現状保存 = ActiveSheet
Worksheets(シート名).Select
現状保存.Visible = False
' Ws.Visible = False ’此れを、戻すと 以ての外、です
Ws.Select ’此れを、外すと ダメです
Application.ScreenUpdating = True
Application.Calculation = xlCalculationManual
Call ダミーデータ作成
Call 項試験回数設定
For j = 1 To 100
Call ダミーデータ作成
t(0) = Timer
Call AWF
t(1) = Timer
t(1) = t(1) - t(0)
t(5) = t(5) + t(1)
t(0) = Timer
Call Eva
t(2) = Timer
t(2) = t(2) - t(0)
t(6) = t(6) + t(2)
t(0) = Timer
Call RuC
t(3) = Timer
t(3) = t(3) - t(0)
t(7) = t(7) + t(3)
t(0) = Timer
Call RuV
t(4) = Timer
t(4) = t(4) - t(0)
t(8) = t(8) + t(4)
Next
Application.Calculation = xlCalculationAutomatic
Debug.Print "Worksheet..Minメソッド", Format(1, "0000.000"), "/", Format(t(5), "###,##0.###")
Debug.Print "Evaluateメソッド ", Format(t(6) / t(5), "0000.000"), "/", Format(t(6), "###,##0.###")
Debug.Print "Loop Range ", Format(t(7) / t(5), "0000.000"), "/", Format(t(7), "###,##0.###")
Debug.Print "Loop Valiant ", Format(t(8) / t(5), "0000.000"), "/", Format(t(8), "###,##0.###")
With 現状保存
.Range(.Cells(1, 1), .Cells(1, 1).SpecialCells(xlLastCell)).Copy Worksheets(シート名).Cells(1, 1)
End With
Application.DisplayAlerts = False
現状保存.Delete
Ws.Delete
Application.DisplayAlerts = True
End Sub
Sub ダミーデータ作成()
With Ws.Range("a1:cv100")
.Formula = "=RANDBETWEEN(1,10000)"
.Calculate
.Value = .Value
End With
Let Ws.Cells(1, 101).Formula = "=MIN(" & Ws.Name & "!" & Ws.Range("a1:cv100").Address & ")"
Ws.Cells(1, 101).Calculate
For s2 = 1 To 100
For s1 = 1 To 100
Data(s1, s2) = Ws.Cells(s1, s2).Value
Next s1
Next s2
Let Data(0, 0) = Ws.Cells(1, 101).Value
End Sub
Sub 項試験回数設定()
Let t(0) = Timer
Let Ch = 0
Do
Call testW
Ch = Ch + 1
Let t(1) = Timer - t(0)
Loop While t(1) < 1
項試験回数 = Ch
Let t(0) = Timer
Let Ch = 0
Do
Call testE
Ch = Ch + 1
Let t(1) = Timer - t(0)
Loop While t(1) < 1
If 項試験回数 < Ch Then Let 項試験回数 = Ch
Let t(0) = Timer
Let Ch = 0
Do
Call testC
Ch = Ch + 1
Let t(1) = Timer - t(0)
Loop While t(1) < 1
If 項試験回数 < Ch Then Let 項試験回数 = Ch
Let t(0) = Timer
Let Ch = 0
Do
Call testV
Ch = Ch + 1
Let t(1) = Timer - t(0)
Loop While t(1) < 1
If 項試験回数 < Ch Then Let 項試験回数 = Ch
Let 項試験回数 = Application.WorksheetFunction.Ceiling(項試験回数 * 1.05, 1)
End Sub
Sub RuV()
For i = 1 To 項試験回数
Call testC
Next i
End Sub
Sub RuC()
For i = 1 To 項試験回数
Call testV
Next i
End Sub
Sub Eva()
For i = 1 To 項試験回数
Call testW
Next i
End Sub
Sub AWF()
For i = 1 To 項試験回数
Call testE
Next i
End Sub
Sub testC()
Ch = 10000
With Ws
For s2 = 1 To 100
For s1 = 1 To 100
If Ch > .Cells(s1, s2).Value Then Ch = .Cells(s1, s2).Value
Next
Next
dummy = Ch
If dummy <> .Cells(1, 101).Value Then Stop
End With
End Sub
Sub testV()
Ch = 10000
For s2 = 1 To 100
For s1 = 1 To 100
If Ch > Data(s1, s2) Then Ch = Data(s1, s2)
Next
Next
dummy = Ch
If dummy <> Data(0, 0) Then Stop
End Sub
Sub testW()
With Ws
dummy = Application.WorksheetFunction.Min(.Range(.Cells(1, 1), .Cells(100, 100)).Value)
If dummy <> .Cells(1, 101).Value Then Stop
End With
End Sub
Sub testE()
With Ws
dummy = Evaluate("Min(" & .Range(.Cells(1, 1), .Cells(100, 100)).Address & ")")
If dummy <> .Cells(1, 101).Value Then Stop’←☆此処で止まり、ダミーが-1000等に…
End With
End Sub
以上
お礼
先ずは書き込み、有難うございます。 (2)に関してですが、一般化して記号のみで3層目まで示して最後に再帰させれば奇麗な樹形図が掛けました。