vba:loopoverfunction
Differences
This shows you the differences between two versions of the page.
|
vba:loopoverfunction [09.12.2013 09:39:54] 127.0.0.1 external edit |
vba:loopoverfunction [21.05.2014 10:16:26] |
||
|---|---|---|---|
| Line 1: | Line 1: | ||
| - | ======[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 | ||
| - | <code vb>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 | ||
| - | </code> | ||
| - | Die Ausgabe ist eine saubere Bit-Reihe | ||
| - | <code> 2 | ||
| - | 4 | ||
| - | 8 | ||
| - | 16 | ||
| - | 32 | ||
| - | 64 | ||
| - | 128 | ||
| - | 256 | ||
| - | 512 | ||
| - | 1024 | ||
| - | 2048 | ||
| - | 4096 | ||
| - | 8192</code> | ||
| - | ---- | ||
| - | 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. | ||
| - | <code vb>'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 <tBlock> Eine Referenz auf den Block. Die übergeben Variable wird somit verändert | ||
| - | ' * @param <Worksheet> Das Worksheet auf dem das ganze abläuft | ||
| - | ' * @param <tParams> Paramter | ||
| - | ' * @return <Boolean> 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</code> | ||
| - | <code>[$A$1:$A$4]: 2 | ||
| - | [$A$5:$A$8]: 2 | ||
| - | [$A$9:$A$12]: 5</code> | ||
| - | {{tag>VBA}} | ||
vba/loopoverfunction.txt · Last modified: 21.05.2014 10:16:26 (external edit)
Page Tools
Except where otherwise noted, content on this wiki is licensed under the following license: GNU Free Documentation License 1.3
