Dokumentation eines Makros

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub PlzZuweisen() Dim j, i As Integer For i = 1 To Range("B65536").End(xlUp).Row For j = 1 To Range("B65536").End(xlUp).Row x = Cells(j, Cells(j, 256).End(xlToLeft).Column + 1).Address If Range("B" & i) = Range("C" & j) Then Cells(j, Cells(j, 256).End(xlToLeft).Column + 1) = Range("A" & i) Next j Next i End Sub

Hallo, Werner,
hier füge die Erläuterung als Kommentar ein, ohne dass ich den Programmcode dort abändere, wo es sich anbieten würde.


Sub PlzZuweisen()
Dim j, i As Integer
' Range("B65536").End(xlUp).Rowliefert die letzte benutzte Reihe der Spalte B
' so dass für alle i = 1 bis i="LastRow der Schleifenkörper
' zwischen For i=... und next i genau einmal durchlaufen wird
' (if i > "LastRow" then end)
For i = 1 To Range("B65536").End(xlUp).Row
' erneut liefert Range("B65536").End(xlUp).Row die letzte benutzte Reihe der Spalte B
' so dass nun für alle j = 1 bis j="LastRow der Schleifenkörper
' zwischen For j=... und next j genau einmal durchlaufen wird
' (if j > "LastRow" then erhöhe Zähler i)
For j = 1 To Range("B65536").End(xlUp).Row
' hier wird nun die Zeile j betrachtet
' und es wird als erstes die Zahl der außerte rechte Spalten in dieser Zeile j,
' die einen Inhalt hat, ermittelt
x = Cells(j, Cells(j, 256).End(xlToLeft).Column + 1).Address
' hier wird der inhalt der aktuellen Zelle Bi mit dem der Zelle Cj verglichen
' Range("B" & i) = Range("C" & j)
' und wenn dieser gleich ist, der Wahrheitwert z.B. der Aussage B3 = C12 WAHR ist,
' dann wird der Zelle in der Zeile j
' Cells(j, ....
' in der ersten freien Zelle nach der letzten  beschriebenen Spalte in
' dieser Zeile j
' ...Cells(j, 256).End(xlToLeft).Column + 1
' der Wert der Zelle Ai eingetragen
If Range("B" & i) = Range("C" & j) Then Cells(j, Cells(j, 256).End(xlToLeft).Column + 1) = Range("A" & i)
' anschließend wir der Schleifenzähler um 1 erhöht (j=j+1)
' und mit dem Wert "LastRow" verglichen. Ist der Wert von j nicht größer, dann wird
' nochmals ein For-j-Schleifendurchlauf für das erhöhte j durchgeführt, ansonsten
' wird die auf next j folgende Anweisung ausgefüht.
' All dieses steckt also im "next j"!
Next j
' Wurde der Grenzwert "LastRow" für j überschritten,
' dann ist die FOR-j-Schleife abgeschlossen
' Es folgt die Erhöhung des Schleifenzählers um 1 (i=i+1).
' Wieder erfolgt der Vergleich dem Wert "LastRow". Ist i nicht größer als LastRow,
' dann wird nochmals ein For-i-Schleifendurchlauf für das erhöhte i gestartet,
' ansonsten wird die auf next i folgende Anweisung ausgefüht.
' Wieder steckt als dieses im "Next i"!
Next i
End Sub

Ich hoffe hierdurch ein paar Deiner Fragen beantwortet zu haben, ansonten: bei Frage, fragen!
Gruß,
Uwe

Hallo Werner,
diese Zeile
If Range("B" & i) = Range("C" & j) Then Cells(j, Cells(j, 256).End(xlToLeft).Column + 1) = Range("A" & i)
sollte so geschrieben werden:
If Range("B" & i) = Range("C" & j) Then
Cells(j, Cells(j, 256).End(xlToLeft).Column + 1) = Range("A" & i)
Exit For
End IF
Wenn eine Übereinstimmung in Spalte "B" und "C" festgestellt wurde, dann
kann die innere For-Schleife verlassen werden. Wozu noch die anderen Zellen
der Spalte "C" durchsuchen?
Anmerkung:
Ob dieses Verfahren in großen Datenbeständen sinnvoll ist, wage ich zu bezweifeln,
da viel zu viel Leerdurchläufe erfolgen.
Hier würde der Find-Befehl besser reinpassen und vor allem schneller sein; _
ich kenne keine selbsterstellte Vba-Routine, die schneller ist als eine equivalente interne Excel-Vba-Funktion!
Gruß von Luschi
aus klein-Paris

Sub PlzZuweisen() Dim j, i As Integer Dim vntRange As Variant Dim ilastRow As Long, iLastCol As Integer ilastRow = Cells(65536, 2).End(xlUp).Row 'letzte Zeile iLastCol = Cells(1, 256).End(xlToLeft).Column + 1 'letzte Spalte + 1 vntRange = Range(Cells(1, 1), Cells(ilastRow, iLastCol)) 'Bereich in Array einlesen 'Array durchsuchen For i = 1 To ilastRow For j = 1 To ilastRow If vntRange(i, 2) = vntRange(j, 3) Then vntRange(j, iLastCol) = vntRange(i, 1) Exit For End If Next j Next i 'Bereich mit Array überschreiben Range(Cells(1, 1), Cells(ilastRow, iLastCol)) = vntRange End Sub

Sub PlzZuweisen() Dim j, i As Integer Dim vntRange As Variant Dim ilastRow As Long, iLastCol As Integer, iCounter As Long ilastRow = Cells(65536, 2).End(xlUp).Row 'letzte Zeile iLastCol = Cells(1, 256).End(xlToLeft).Column + 1 'letzte Spalte + 1 iCounter = 1 vntRange = Range(Cells(1, 1), Cells(ilastRow, iLastCol)) 'Bereich in Array einlesen 'Array durchsuchen For i = 1 To ilastRow For j = 1 To ilastRow If vntRange(i, 2) = vntRange(j, 3) Then iCounter = iCounter + 1 vntRange(iCounter, iLastCol) = vntRange(i, 1) Exit For End If Next j Next i 'Bereich mit Array überschreiben Range(Cells(1, 1), Cells(ilastRow, iLastCol)) = vntRange End Sub

Beliebteste Forumthreads (12 Monate)

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread