Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
724to728
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
724to728
724to728
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Knoten in For Schleife

Knoten in For Schleife
26.01.2006 23:56:06
Daniel
Hallo allerseits,
Hier ist mein Code, dh. eigentlich ist er nicht direkt von mir. Ich habe ihn hier im Forum bekommen und ihn dann ein Bisschen kaputt gebastelt.
Es soll die Zeichenfolge Rang gesucht werden danach soll die Rangfolge für die Spalte links neben der Rangspalte unter der Rangspalte eingetragen werden.
Das funktioniert aber nur für das erste Tabellenblatt. Wo ist mein Knoten und wie kann man das ganze evtl. noch optimieren. Würde Euch nicht nerven, wenn ich nicht selber schon wieder so lange daran verzweifeln würde.
Dankeschön,
Daniel
Die Arbeitsmappe:
https://www.herber.de/bbs/user/30423.xls
Der Code:

Sub Rang_suchen_und_eintragen()
Dim rngZelle As Range, z$, s%
Dim myObject As Object
Dim ws As Worksheet
For Each Worksheet In ActiveWorkbook.Sheets
Set myObject = Range("A1:A15")
Set pruef = Cells(65535, 256)
For Each col In myObject
Cells.Find(What:="Rang", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Set pruef = ActiveCell.Offset(1, 0)
'If IsEmpty(pruef.Offset(1, 0)) Then Exit For
Spalte = ActiveCell.Column
z = Cells(65536, Spalte - 1).End(xlUp).Row
adr = Cells(2, Spalte - 1).Address(0, 0)
ber = Range(Cells(2, Spalte - 1), Cells(z, Spalte - 1)).Address
Cells(2, Spalte).Formula = "=Rank(" & adr & "," & ber & ")"
Cells(2, Spalte).Copy Destination:=Range(Cells(3, Spalte), Cells(z, Spalte))
Next col
Next Worksheet
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Knoten in For Schleife
27.01.2006 05:38:37
Jan3
Hi,
Anbei eine veränderte VBA-Code-Variante. Teste den Code mal durch.

Sub Rang_suchen_und_eintragen()
Dim rngZelle As Range, z$, s%
Dim myObject As Object
Dim ws As Worksheet
For Each Worksheet In ActiveWorkbook.Sheets
r = 0
Set myObject = Range("A1:A15")
Set pruef = Cells(65535, 256)
For Each col In myObject
Cells.Find(What:="Rang", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Set pruef = ActiveCell.Offset(1, 0)
If IsEmpty(pruef.Offset(1, 0)) Then Exit For
Spalte = ActiveCell.Column
z = Cells(65536, Spalte - 1).End(xlUp).Row
adr = Cells(2, Spalte - 1).Address(0, 0)
ber = Range(Cells(2, Spalte - 1), Cells(z, Spalte - 1)).Address
Cells(2, Spalte).Formula = "=Rank(" & adr & "," & ber & ")"
Cells(2, Spalte).Copy Destination:=Range(Cells(3, Spalte), Cells(z, Spalte))
If r > 3 Then Exit For
r = r + 1
Next col
Next
End Sub

Jan
Anzeige
Funktioniert noch nicht
27.01.2006 10:36:13
Daniel
Hi Jan.
Läuft leider immer noch nur für das erste Tabellenblatt.
Ich muss aber alle Blätter ranken.
Hast Du oder jemand anderes noch weitere Vorschläge?
Die Arbeitsmappe habe ich hochgeladen (s.o.).
Viele Grüße,
Daniel
AW: Funktioniert noch nicht
29.01.2006 17:25:44
Jan3
Hi,
Ich hatt noch eine Befehlszeile vergessen.

Sub Rang_suchen_und_eintragen()
Dim rngZelle As Range, z$, s%
Dim myObject As Object
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Sheets
r = 1
ws.Activate
Set myObject = ws.Range("A1:A17")
Set pruef = ws.Cells(65535, 256)
For Each col In myObject
Cells.Find(What:="Rang", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
Set pruef = ActiveCell.Offset(0, -1)
If IsEmpty(pruef.Offset(1, 0)) Then Exit For
Spalte = ActiveCell.Column
z = Cells(65536, Spalte - 1).End(xlUp).Row
adr = Cells(2, Spalte - 1).Address(0, 0)
ber = Range(Cells(2, Spalte - 1), Cells(z, Spalte - 1)).Address
Cells(2, Spalte).Formula = "=Rank(" & adr & "," & ber & ")"
Cells(2, Spalte).Copy Destination:=Range(Cells(3, Spalte), Cells(z, Spalte))
If r > 3 Then Exit For
r = r + 1
Next col
Next
End Sub

Jan
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige