Yaslaw.Info

This page is read only. You can view the source, but not change it. Ask your administrator if you think this is wrong.
======[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}}
Yaslaw.Info

User Tools

Site Tools

Page Tools
