Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
820to824
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
820to824
820to824
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Bereich durchsuchen

Bereich durchsuchen
17.11.2006 12:22:15
Ryu_Hoshi
Hallo!
Ich habe eine Tabelle mit Daten. In der ersten Zeile sind Überschriften und ab zweiter Zeile abwärts folgen die Datensätze. Ich möchte nun mit VBA erreichen, dass Excel mit der zweiten Zeile anfängt (Zeile für Zeile nach unten bis zu letzten Zeile) und prüft ob der Wert in Spalte "I" einen bestimmten Wert, z.B. "Test" entspricht. Und wenn nun in der Spalte "I" Test steht soll die ganze Zeile ausgeschnitten und in eine andere Datei in eine bestimmte Tabelle eingefügt werden (In dieser ist in der ersten Zeile Überschriften und Rest leer). So sollten nacheinander alle Zeilen mit Wert Test in Spalte I nacheinander in eine andere Datei (ab zweiter Zeile) kopiert werden.
Kann mir bitte jemand mit dem Code helfen?

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bereich durchsuchen
17.11.2006 15:33:57
Fritz
Hallo,
versuchs mal hiermit
Gruß Fritz
Option Explicit

Sub xx()
Dim I&, J&, X&, LZ1&, LS1&, LZ2&, LS2&
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Set Ws1 = Sheets(1)
Set Ws2 = Sheets(2)
LZ1 = GetLastRow(Ws1)
LZ2 = GetLastRow(Ws2)
LS1 = GetLastCol(Ws1)
LS2 = GetLastCol(Ws2)
I = 2
X = LZ2 + 1
Do While I < LZ1
If Ws1.Cells(I, 9) = 2 Then
For J = 10 To LS1
Ws2.Cells(X, J - 9) = Ws1.Cells(I, J)
Ws1.Cells(I, J) = ""
Next
X = X + 1
End If
I = I + 1
Loop
Set Ws1 = Nothing
Set Ws2 = Nothing
End Sub


Function GetLastRow(Ws As Worksheet) As Long
GetLastRow = Ws.Range("A65536").End(xlUp).Row
End Function


Function GetLastCol(Ws As Worksheet) As Long
GetLastCol = Ws.Cells(1, Columns.Count).End(xlToLeft).Column
End Function

Anzeige
AW: Bereich durchsuchen
17.11.2006 16:28:10
Ryu_Hoshi
Hallo Fritz!
Danke schön für deine Hilfe! Ich werde heute nicht mehr dazukommen es auszuprobieren. Ich schaue es mir am Wochenende an und mele mich Anfang der Woche wieder.
Gruss
Ryu
Hallo Fritz
20.11.2006 10:53:24
Ryu_Hoshi
Ich habe deinen Code ausprobiert aber bekomme hier:
"GetLastRow = Ws.Range("A65536").End(xlUp).Row"
den Fehler 91: Objektvariable oder With-Blockvariable nicht festgelegt.
Hast du eine Idee warum?
AW: Hallo Fritz
20.11.2006 13:39:51
Fritz
Hallo Ryu,
es wird die Anzahl der Zeilen anhand der Einträge Spalte "A" ermittelt.
Wenn hier nichts drin steht kommt dieser Fehler.
ansonsten mal versuchen mit:
LetzteZeile = Cells.SpecialCells(xlCellTypeLastCell).Row
Gruß
Fritz
Anzeige
AW: Hallo Fritz
20.11.2006 13:49:49
Fritz
So müsste es auch gehen
Letztezeile = ActiveSheet.Range("A65536").End(xlUp).Row
Gruß Fritz
AW: Hallo Fritz
20.11.2006 16:58:35
Ryu_Hoshi
Sorry Habe deine Antwort erst jetzt entdeckt (ich hatte inzwischen einen neuen Beitrag heute zu diesem Thema geschrieben). Ich hatte einige Änderungen vorgenommen.
Mein jetziger Code sieht so aus:

Sub xx2()
Dim I&, X&, LZ1&, LS1&, LZ2&, LS2&
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
'Festlegen der Quelldatei
Set Ws1 = Workbooks("Top 5 all Sections - Oktober 06.xls").Sheets("5 Surface")
LZ1 = Ws1.Range("A15000").End(xlUp).Row
LS1 = Ws1.Cells(1, Columns.Count).End(xlToLeft).Column
I = 2
'Zieldatei aufmachen
Workbooks.Open "C:\Test\Master.xls"
Sheets("Test").Select
Set Ws2 = Workbooks("Master.xls").Sheets("Test")
LZ2 = Ws2.Range("A15000").End(xlUp).Row '65536 ist hier nicht nötig
LS2 = Ws2.Cells(1, Columns.Count).End(xlToLeft).Column
X = LZ2 + 1
Do While I < LZ1
If Ws1.Cells(I, 10).Value = "STG" Then
Ws1.Rows(I).Select
Application.CutCopyMode = False
Selection.Cut
Ws2.Activate
Rows(X).Select
ActiveSheet.Paste
X = X + 1
End If
I = I + 1
Loop
End Sub

Jetzt läuft der Code ohne Fehler durch, aber er kopiert nichts rüber. Hast du eine Idee warum?
Anzeige
AW: Hallo Fritz
20.11.2006 17:49:26
Fritz
Findet er denn in der Spalte 10 (("J") auch den Wert "STG" ?
vielleicht mal im Einzelschrittmodus ausführen und schauen, was er macht, wenn er was findet.
Gruß Fritz
AW: Hallo Fritz
21.11.2006 15:00:34
Ryu_Hoshi
Hallo Fritz,
Ich habe das Gefühl dass er "STG" nicht findet obwohl es da steht. Ich habe eine Beispieldatei hochgeladen. Vielleicht fällt jemanden damit auf warum es nicht geht...
https://www.herber.de/bbs/user/38371.xls
"STG " <> "STG"
21.11.2006 15:08:02
EtoPHG
Hallo Ryu,
In Deine Spalte J steht nirgends "STG" sonder "STG "
Gruss Hansueli
AW: "STG " <> "STG"
21.11.2006 16:48:38
Ryu_Hoshi
Hallo EtoPHG,
Danke für deinen Beitrag. Mir ist leider unklar was du damit meinst. Es steht doch "STG" drin! Kannst du es mir bitte erklären?
Gruss
Ryu
Anzeige
AW: "STG " <> "STG"
21.11.2006 16:57:17
Reinhard
Hi Ryu,
In Deine Spalte J steht nirgends "STG" sondern "STG       "
Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..

AW: "STG " <> "STG"
21.11.2006 18:26:19
EtoPHG
Hallo Ryu,
Hinter Deinem STG sind noch ein paar Leerzeichen!
Gruss Hansueli
genau das war es!!
22.11.2006 14:18:27
Ryu_Hoshi
Jetzt läuft der Code!
Auch wenn Screenupdating nicht funktioniert (ich sehe noch immer wie der Code abläuft)...
Danke schön an alle!!!
Hier der momentane Code:

Sub Produkte_verteilen()
Dim I&, X&, LZ1&, LS1&, LZ2&, LS2&, Z&
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
'Festlegen der Quelldatei
Set Ws1 = Workbooks("Top 5 all Sections - Oktober 06.xls").Sheets("5 Surface")
LZ1 = Ws1.Range("A15000").End(xlUp).Row
LS1 = Ws1.Cells(1, Columns.Count).End(xlToLeft).Column
I = 2
Z = 0
ScreenUpdating = False
'Zieldatei aufmachen
Workbooks.Open "C:\Test\Master.xls"
Sheets("HXID+EP 1.6").Select
Set Ws2 = Workbooks("Master.xls").Sheets("HXID+EP 1.6")
LZ2 = Ws2.Range("A15000").End(xlUp).Row
LS2 = Ws2.Cells(1, Columns.Count).End(xlToLeft).Column
X = LZ2 + 1
Do While I < LZ1
If Ws1.Cells(I, 10).Value = "STG     " Then
Ws1.Rows(I).Copy
Ws2.Rows(X).Select
ActiveSheet.Paste
Ws1.Rows(I).Delete
X = X + 1
Z = 1
End If
If Z = 1 Then
Else
I = I + 1
End If
ScreenUpdating = True
Z = 0
Loop
Set Ws1 = Nothing
Set Ws2 = Nothing
End Sub

Anzeige
AW: genau das war es!!
22.11.2006 14:28:13
EtoPHG
Hallo Ryu,
Das heisst:

Am Anfang:   Application.ScreenUpdating = False
Dazwischen:  Dein Code, aber mit der richtigen Anzahl Leerstellen ;-)
Am Ende:     Application.ScreenUpdating = True

Gruss Hansueli

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige