======[VBA] Loop über eine Funktion steuern======
Manchmal will man eine Sub mehrmals ausführen bis ein Argument erfüllt ist. Damit kann man auch eine Schleife erstellen die etwas andere Schritte als eine normale for-Schleife ermöglicht
Public Sub test()
Dim val As Long
val = 1
'In der While-Schleife die Funktion aufrufen und auf den Rückgabewert prüfen
'Der erste Parameter ist als Referenz definiert. Somit wird dieser bei
'jedem Durchgang angepasst
Do While calc2(val, 10000)
Debug.Print val
Loop
End Sub
Private Function calc2(ByRef ioVal As Long, ByVal iMax As Long) As Boolean
'Neuer Wert berechnen
ioVal = ioVal * 2
'Auf gültigkeit prüfen
calc2 = ioVal <= iMax
End Function
Die Ausgabe ist eine saubere Bit-Reihe
2
4
8
16
32
64
128
256
512
1024
2048
4096
8192
----
Das Beispiel könnte man natürlich auch ohne die Funktion machen. Als weitere Beispiel habe ich etwas komplexeres. Im Excel ist in der Spalte A eine Zahlenreihe. Diese soll in 4er-Blöcke unterteilt werden. Von jedem 4er-Block soll das Minimum ermittelt werden.
'Definition des Blockes
Private Type tBlock
nr As Integer 'Aktuelle Nr des Blockes
startRowNr As Integer 'Start Zeile des Blocks
startCell As Range 'Start Zelle
endRowNr As Integer 'End Zeile
endCell As Range 'End Zelle
rng As Range 'Der Black als Range
End Type
'Parametersammlung
Private Type tParams
blockSize As Integer
searchColNr As Integer
targetColNr As Integer
End Type
'/**
' * Die zu startende Methode
' */
Public Sub startMe()
Dim block As tBlock
Dim params As tParams
'Parameter übernehmen
With params
.blockSize = 4
.searchColNr = 1
.targetColNr = 2
End With
'Ein Block vorrücken solange Daten vorhanden sind
Do While moveBlock(block, ActiveSheet, params)
'Minimum des Blocks ausgeben
Debug.Print "[" & block.rng.Address & "] " & Application.WorksheetFunction.Min(block.rng)
Loop
End Sub
'/**
' * Verschiebt den Block und gibt true/false zurück. Je nachdem ob Daten vorhanden sind oder nicht
' * @param Eine Referenz auf den Block. Die übergeben Variable wird somit verändert
' * @param Das Worksheet auf dem das ganze abläuft
' * @param Paramter
' * @return Trae/False. Aussage darüber ob der Block Daten enthält
' */
Private Function moveBlock(ByRef ioBlock As tBlock, ByVal iSh As Worksheet, ByRef iParams As tParams) As Boolean
With ioBlock
.nr = .nr + 1
.startRowNr = .endRowNr + 1
.endRowNr = .endRowNr + iParams.blockSize
Set .startCell = iSh.Cells(.startRowNr, iParams.searchColNr)
Set .endCell = iSh.Cells(.endRowNr, iParams.searchColNr)
Set .rng = iSh.Range(.startCell, .endCell)
'http://ewbi.blogs.com/develops/2006/03/determine_if_a_.html
moveBlock = (WorksheetFunction.CountBlank(.rng) <> .rng.Count)
End With
End Function
[$A$1:$A$4]: 2
[$A$5:$A$8]: 2
[$A$9:$A$12]: 5
{{tag>VBA}}