7
VBA Zeilen in andere Tab kopieren
Hallo zusammen,
ohne Eure Unterstützung will es einfach nicht funktionieren!!!
Suche in Tab1 Spalte D nach "K/E" (wenn gefunden) dann kopiere die Nummer aus Spalte A in Tab2 in die Spalte mit den ensprechenden Tagen (siehe Bild Tab2). Nummer "809306" in die Spalte >1000 Tage.
Next "K/E.
Alle "K/E" gefunden und kopiert, weiter mit "K/M" (siehe Tab 3)
Suche in Tab1 Spalte D nach "K/M" (wenn gefunden) dann kopiere die Nummer aus Spalte A in Tab3 in die Spalte mit den ensprechenden Tagen (siehe Bild Tab3). Nummer "801561" und "802277" in die Spalte 101 - 249 Tage.
Next "K/M.
Bild für die Erweiterung
Hier Bild Tab Extra 2
Ergebnis Code 2
Share on Facebook
Share on Twitter
Share on Reddit
Share on LinkedinPlease also mark the comments that contributed to the solution of the article
Content-Key: 148030
Url: https://administrator.de/contentid/148030
Printed on: April 24, 2024 at 14:04 o'clock
7 Comments
Latest comment
Hallo matester!
Versuch es damit:
Da die Überschriften in den Zieltabellen für die Einordnung lt Tageanzahl nur bedingt auswertbar sind, habe ich die entsprechende Funktionaliltät (entsprechend der Vorlage gilt für jede der beide Zieltabellen die selbe Spaltenzuordnung) in der Zeile 26 mit Konstanten hinterlegt.
Ab Zeile 33 kann (derzeit nur angedeutet) auf die Tatsache reagiert werden, dass der "Berich" weder "K/E" noch "K/M" ist; falls solche Quellzeilen einfach zu ignorieren wären, müssten nur die Zeilen 32 und 33 entfernt werden.
Es wird vermutlich noch erforderlich sein, vorweg die Einträge ab Zeile 2 der Zieltabellen zu löschen, da die neuen Einträge immer unterhalb schon bestehendere Inhalte hinzugefügt werden. Eine passende Codezeile könnte im einfachsten Fall so aussehen:
Grüße
bastla
Versuch es damit:
Sub Zuordnen()
QTabelle = "Tab1"
QAbZeile = 2 'Daten ab Zeile 2 in
QSpalte = 1 'Spalte "A"
With Worksheets(QTabelle) 'Quelltabelle vorgeben
QZeile = QAbZeile 'in "AbZeile" beginnen
Nr = .Cells(QZeile, QSpalte).Value 'Nr auslesen
Do While Nr <> "" 'Schleife, solange noch Daten vorhanden sind
'Kennzeichen "Berich" prüfen und entsprechende Tabelle zuordnen
Berich = .Cells(QZeile, QSpalte + 3).Value
Select Case Berich
Case "K/E"
ZTabelle = "Tab2"
Case "K/M"
ZTabelle = "Tab3"
Case Else
ZTabelle = ""
End Select
If ZTabelle <> "" Then 'passendes Kennzeichen gefunden
Tage = Val(.Cells(QZeile, QSpalte + 2).Value) 'Tageanzahl lesen
'Zugeordnete Spalte lt Tageanzahl ermitteln
ZSpalte = Switch(Tage <= 100, "B", Tage < 250, "C", Tage <= 500, "D", Tage <= 750, "E", Tage <= 1000, "F", Tage > 1000, "G")
'Nächste freie Zelle in der entsprechenden Spalte suchen
ZZeile = Worksheets(ZTabelle).Cells(65536, ZSpalte).End(xlUp).Row + 1
Worksheets(ZTabelle).Cells(ZZeile, ZSpalte).Value = Nr 'Nr eintragen
Else ' passendes Kennzeichen nicht gefunden
MsgBox "Für Nr " & Nr & " (siehe Zeile " & QZeile & ") konnte keine Zuordnung zu einer Zieltabelle vorgenommen werden!"
'Exit Sub 'Abbruch
End If
QZeile = QZeile + 1 'nächste Datenteile
Nr = .Cells(QZeile, QSpalte).Value 'Nr auslesen
Loop
End With
MsgBox "Fertig."
End SubAb Zeile 33 kann (derzeit nur angedeutet) auf die Tatsache reagiert werden, dass der "Berich" weder "K/E" noch "K/M" ist; falls solche Quellzeilen einfach zu ignorieren wären, müssten nur die Zeilen 32 und 33 entfernt werden.
Es wird vermutlich noch erforderlich sein, vorweg die Einträge ab Zeile 2 der Zieltabellen zu löschen, da die neuen Einträge immer unterhalb schon bestehendere Inhalte hinzugefügt werden. Eine passende Codezeile könnte im einfachsten Fall so aussehen:
Worksheets("Tab2").Range("A2:G65536").ClearContents
bastla
Guten Tag bastla,
eine SUPER Leistung!!! Dieser Code ist eine volle Punktlandung!!!
Vielen Dank für Deine Hilfe, einfach SUPER.
Hier habe ich noch einige Fragen:
1) Wie sieht der Code aus, wenn ich nur die Begriffe auslesen und die Zeilen in eine andere Tabelle kopieren möchte?
2) Ist es möglich auch den Code so zu ändern, dass die Begriffe in der Spalte D automatisch ausgelesen werden,
ohne die Begriffe mit "K/L" vorzugeben??? Also, suche alle Begrigffe in D durch und lege automatisch die
entsprechenden Tabellen mit der Zuordnung der Tagen an?
3) Wie kann ich diesen Code verwenden, wenn ich wie in dem Bild (Tab Extra) nur die Spalten C, E, G, I, K, M
nach den Begriffen "K/E", "K/M", "K/L" . . . ablaufen lassen und dann als 2. Abfrage nach den Spalten
B, D, F, H, J, L nach den selben Begriffen "K/E", "K/M", "K/L" . . .
suchen und je in die Tabellen K/E (Tab2), K/L (Tab3), K/M (Tab4) kopieren möchte?
Ergebnisse wie Bild Tab2 und Bild Tab3
Vielen Dank im Voraus
eine SUPER Leistung!!! Dieser Code ist eine volle Punktlandung!!!
Vielen Dank für Deine Hilfe, einfach SUPER.
Hier habe ich noch einige Fragen:
1) Wie sieht der Code aus, wenn ich nur die Begriffe auslesen und die Zeilen in eine andere Tabelle kopieren möchte?
2) Ist es möglich auch den Code so zu ändern, dass die Begriffe in der Spalte D automatisch ausgelesen werden,
ohne die Begriffe mit "K/L" vorzugeben??? Also, suche alle Begrigffe in D durch und lege automatisch die
entsprechenden Tabellen mit der Zuordnung der Tagen an?
3) Wie kann ich diesen Code verwenden, wenn ich wie in dem Bild (Tab Extra) nur die Spalten C, E, G, I, K, M
nach den Begriffen "K/E", "K/M", "K/L" . . . ablaufen lassen und dann als 2. Abfrage nach den Spalten
B, D, F, H, J, L nach den selben Begriffen "K/E", "K/M", "K/L" . . .
suchen und je in die Tabellen K/E (Tab2), K/L (Tab3), K/M (Tab4) kopieren möchte?
Ergebnisse wie Bild Tab2 und Bild Tab3
Vielen Dank im Voraus
Hallo matester!
Die Fragen 1 und 3 (geht es hier um Anzahlen?) sind in der aktuellen Formulierung für mich leider nicht verständlich
...
Zu 2)
Das Gerüst zum Auslesen aller unterschiedlichen Einträge in Spalte D und Erstellen zugeordneter Tabellen könnte etwa so aussehen:
Für jeden unterschiedlichen Eintrag in Spalte D wird (falls noch nicht vorhanden) ein Tabellenblatt hinzugefügt und nach dem Eintrag benannt. Da "K/E" kein zulässiger Tabellenname ist, wird "/" durch "_" ersetzt. In weiterer Folge kann dann das erste Script oben so angepasst werden, dass die Zieltabelle direkt aus dem aus Spalte D ausgelesenen Kennzeichen ermittelt wird.
Kurz zu einem Teilaspekt meines Ansatzes:
Zum Sammeln aller unterschiedlichen Kennzeichen in einem String werden diese durch "#" (kann auch ein anderes, nicht in den Kennzeichen-Werten vorkommendes Zeichen sein) begrenzt hinzugefügt, sodass für das Beispiel mit "K/E", "K/M" und "K/L" nach dem Durchlaufen aller nicht-leeren Zellen in Spalte D (ab Zeile 2) der Inhalt der Variablen "Kennzeichen" "#K_E#K_M#K_L#" lauten würde (die "/" wurden bereits umgewandelt). Die Abgrenzung durch "#" nach beiden Seiten ist erforderlich, damit nicht Teilstrings gefunden und damit einzelne Werte ausgelassen werden - Beispiel: Wenn ein Kennzeichen "K_E2" bereits vorhanden wäre, würde bei einem einfachen Vergleich mit "K_E" das Ergebnis lauten: "schon vorhanden, wird nicht hinzugefügt"; wird aber "#K_E2#" mit "#K_E#" verglichen, gibt es keine Übereinstimmung.
Grüße
bastla
Die Fragen 1 und 3 (geht es hier um Anzahlen?) sind in der aktuellen Formulierung für mich leider nicht verständlich
...Zu 2)
Das Gerüst zum Auslesen aller unterschiedlichen Einträge in Spalte D und Erstellen zugeordneter Tabellen könnte etwa so aussehen:
Sub Erstellen()
QTabelle = "Tab1"
QAbZeile = 2 'Daten ab Zeile 2 in
QSpalte = "D"
'Kennzeichen auslesen
Kennzeichen = "#" 'Variable vorbelegen, damit auch der erste Eintrag "links" abgegrenzt ist
With Worksheets(QTabelle) 'Quelltabelle vorgeben
QZeile = QAbZeile 'in "AbZeile" beginnen
K = .Cells(QZeile, QSpalte).Value 'Kennzeichen auslesen
Do While K <> "" 'Schleife, solange noch Daten vorhanden sind
If InStr(Kennzeichen, "#" & K & "#") = 0 Then 'noch nicht in den gesammelten Kennzeichen enthalten
Kennzeichen = Kennzeichen & Replace(K, "/", "_") & "#" 'aktuelles Kennzeichen hinzufügen (dabei "/" durch "_" ersetzen)
End If
QZeile = QZeile + 1 'nächste Datenteile
K = .Cells(QZeile, QSpalte).Value 'Kennzeichen auslesen
Loop
End With
'Tabellen erstellen
Kenn = Split(Mid(Kennzeichen, 2, Len(Kennzeichen) - 2), "#") 'Array erzeugen (vorweg die Begrenzungszeichen an Anfang und Ende eliminieren)
For Each SheetName In Kenn 'alle Kennzeichen durchgehen
IsNew = True 'Schalter; zeigt an, ob Tabellenblatt erstellt werden kann
For Each ExistingSheet In Worksheets 'alle bestehenden Tabellenblätter durchgehen und ...
If LCase(ExistingSheet.Name) = LCase(SheetName) Then '... überprüfen, ob ein gleichnamiges Blatt bereits vorhanden ist
IsNew = False 'Falls ja: Schalter setzen und ...
Exit For '... Überprüfung abbrechen
End If
Next
If IsNew Then 'Wenn Blatt mit dem geprüften Namen noch nicht vorhanden ist, ...
Set NewSheet = Worksheets.Add(After:=Sheets(Sheets.Count)) '... neues Tabellenblatt am Ende der Mappe hinzufügen und ...
NewSheet.Name = SheetName '... entsprechend benennen
End If
Next
Set NewSheet = Nothing
End SubKurz zu einem Teilaspekt meines Ansatzes:
Zum Sammeln aller unterschiedlichen Kennzeichen in einem String werden diese durch "#" (kann auch ein anderes, nicht in den Kennzeichen-Werten vorkommendes Zeichen sein) begrenzt hinzugefügt, sodass für das Beispiel mit "K/E", "K/M" und "K/L" nach dem Durchlaufen aller nicht-leeren Zellen in Spalte D (ab Zeile 2) der Inhalt der Variablen "Kennzeichen" "#K_E#K_M#K_L#" lauten würde (die "/" wurden bereits umgewandelt). Die Abgrenzung durch "#" nach beiden Seiten ist erforderlich, damit nicht Teilstrings gefunden und damit einzelne Werte ausgelassen werden - Beispiel: Wenn ein Kennzeichen "K_E2" bereits vorhanden wäre, würde bei einem einfachen Vergleich mit "K_E" das Ergebnis lauten: "schon vorhanden, wird nicht hinzugefügt"; wird aber "#K_E2#" mit "#K_E#" verglichen, gibt es keine Übereinstimmung.
Grüße
bastla
Hallo bastla!
Den Teil mit dem Testen/Erstellen des jeweiligen Sheets, könnte man der Einfachheit halber auch so machen:
Gruß Dieter
Den Teil mit dem Testen/Erstellen des jeweiligen Sheets, könnte man der Einfachheit halber auch so machen:
'Snip......
For Each SheetName In Kenn
Set NewSheet = Nothing
On Error Resume Next: Set NewSheet = Sheets(SheetName): On Error GoTo 0
If NewSheet Is Nothing Then
Set NewSheet = Worksheets.Add(After:=Sheets(Sheets.Count)): NewSheet.Name = SheetName
End If
Next
'Snip...... Gruß Dieter
Hallo Dieter!
Stimmt - sieht so besser aus ...
Grüße
bastla
Stimmt - sieht so besser aus ...
Grüße
bastla
Hallo bastla,
zu1 wenn der Begriff „K-E“ in Spalte D vorhanden ist, kopiere die entsprechende Zeile In die Tab2 bzw. bei „K-A“ kopiere
die Zeile in Tab3.
Es geht hier nur um das Kopieren, ich möchte VB nur verstehen!!!
Ich habe zur Vereinfachung alle Begriffe auf K-M, K-L, K-E umgestellt (das mit dem Sonderzeichen "/" sieht sehr gefährlich aus).
Wenn ich Sub Erstellen() laufen lasse, bekomme ich das Ergebnis siehe Bild Code 2.
Die neuen Tabellen aber ohne Inhalt.
Was müsste ich aus Sub Erstellen() herausnehmen, wenn die Begriffe nicht "K/E" sondern nur "K-E" lauten würden???
Um den Code schlanker zu gestallten.
zu3 sollten wie in Bild (Tab Extra) nur die Spalten C, E, G, I, K, M nach den Begriffen "K-E", "K-M", "K-L" . . . ausgelesen und
kopiert werden (Ergebnis Bild Tab Extra 2).
Und dann als neue Abfrage sollten wie in Bild (Tab Extra) nur die Spalten B, D, F, H, J, L nach den selben Begriffen
"K-E", "K-M", "K-L" . . . ausgelesen und kopiert werden (Ergenis Bild Tab Extra 2).
D.h. für K-E (in Tab Extra 2), für K-L (in Tab Extra 3), K-M (in Tab Extra 4).
Aber viel wichtiger ist erstmal der Dank, dass du dich diesem Thema angenommen hast sowie die Unterstützung von Dieter!!!
DANKE . . .
zu1 wenn der Begriff „K-E“ in Spalte D vorhanden ist, kopiere die entsprechende Zeile In die Tab2 bzw. bei „K-A“ kopiere
die Zeile in Tab3.
Es geht hier nur um das Kopieren, ich möchte VB nur verstehen!!!
Ich habe zur Vereinfachung alle Begriffe auf K-M, K-L, K-E umgestellt (das mit dem Sonderzeichen "/" sieht sehr gefährlich aus).
Wenn ich Sub Erstellen() laufen lasse, bekomme ich das Ergebnis siehe Bild Code 2.
Die neuen Tabellen aber ohne Inhalt.
Was müsste ich aus Sub Erstellen() herausnehmen, wenn die Begriffe nicht "K/E" sondern nur "K-E" lauten würden???
Um den Code schlanker zu gestallten.
zu3 sollten wie in Bild (Tab Extra) nur die Spalten C, E, G, I, K, M nach den Begriffen "K-E", "K-M", "K-L" . . . ausgelesen und
kopiert werden (Ergebnis Bild Tab Extra 2).
Und dann als neue Abfrage sollten wie in Bild (Tab Extra) nur die Spalten B, D, F, H, J, L nach den selben Begriffen
"K-E", "K-M", "K-L" . . . ausgelesen und kopiert werden (Ergenis Bild Tab Extra 2).
D.h. für K-E (in Tab Extra 2), für K-L (in Tab Extra 3), K-M (in Tab Extra 4).
Aber viel wichtiger ist erstmal der Dank, dass du dich diesem Thema angenommen hast sowie die Unterstützung von Dieter!!!
DANKE . . .
Hallo matester!
Ich nehme an, mit den Infos aus Deinem anderen Thread sind für Dich inzwischen alle 3 Teilbereiche lösbar - falls ja, könntest Du beide Beiträge als "erledigt" kennzeichnen ...
[Edit] Danke [/Edit]
Grüße
bastla
Ich nehme an, mit den Infos aus Deinem anderen Thread sind für Dich inzwischen alle 3 Teilbereiche lösbar - falls ja, könntest Du beide Beiträge als "erledigt" kennzeichnen ...
[Edit] Danke
[/Edit]Grüße
bastla
