Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

VBA: Mit Textbausteinen finden und Zeile kopieren?
#1
Guten Tag zusammen,

ich beschäftige mich noch nicht sehr lange mit VBA. Doch ich sitze nun vor einer Problemstellung die ohne nicht zu bewältigen ist denke ich.

Ich habe hier einen Tabelle vor mir.

50 Spalten a 2000 Zeilen.
Dort finden sich viele verschiedene Posten durcheinander.

Ich brauche ein Makro, welches die Tabelle Sheet1 auf Stichworte durchsucht.
Bsp.

1.         Stehlampe              5  Stck             
2.         Wandlampe            2  Stck             
3.         Teppich                  5  Stck             
4.         Stehlampe              2  Stck      

Ich würde gerne nur nach einem Teil der Bezeichnung suchen können.
Bsp. 

-lampe

Die Teilbezeichnungen bzw. meine Suchbegriffe sollten sich nach Möglichkeit ebenfalls in einem Arbeitsblatt in einer Spalte z.B. (A1) befinden. So das es dann möglich eine grosse unübersichtliche Liste in Unterteilungen zu gliedern.

Dann sollen immer ALLE Zeilen der Tabelle in denen eine Zelle  mit den oben gesuchten Parametern ist in ein anderes Arbeitsblatt Sheet2 beginnend bei B3 kopiert werden
Bsp.



1.         Stehlampe             5Stck
2.         Wandlampe           5Stck
4.         Stehlampe             2Stck

Im nächsten Schritt würde ich gerne gleiche Artikel untereinander Ordnen (obwohl dies ja auch ohne VBA machbar wäre, doch es wäre toll wenn man sowas direkt mit i den Code packen könnte)

1.         Stehlampe             5Stck
4.         Stehlampe             2Stck
2.         Wandlampe           5Stck


Die große Schwierigkeit die noch vorliegt ist, dass die bei mir ankommende Tabelle nocht sauber gegliedert ist, es kann massieren das es so aussieht

1.                 5Stck                     Stehlampe
2.                 Wandlampe            2  Stck             
3Stck            Teppich                  3.          
4.                 Stehlampe              2  Stck      

Daher muss das Suchmakro nicht auf eine Spalte festgelegt sein, sondern jede Zelle in der Tabelle suchen.

Über erste Ideen oder Ansätze wäre ich sehr dankbar!!1



LG


Orgel
Antworten Top
#2
Hallo,

der erste Teil ist "relativ einfach" mit VBA Range.find zu lösen. Der letzte Teil ist kompliziert! Ohne klare Ansage, dass nur Spalte A und C vertauscht sein können (oder ähnliches) ist es kaum zu machen: jeder Fall könnte einen eigenen Code erfordern.

Ist es möglich eine Bsp-Datei zu erstellen, die einen Überblick über die Varianten gibt?

mfg
Antworten Top
#3
Erstmal vielen Danke für deine Antwort.

Ich habe mir die Tabellen aus den letzten Jahren nochmal angesehen, und ich glaub ich hab das etwas falsch erklärt.

Die Tabellen haben immer 2 Spalten die Textinformationen enthalten.
Diese Spalten sind in jeder Tabelle einheitlich. Diese Spalten muss ich ordnen können. Meinst ist es in Tabelle C oder D könnte aber auch mal E sein.

Eine Tabelle die erklärt was ich meine kann ich gerne morgen mal vorbereiten.
Antworten Top
#4
Hallo,

für den ersten Einstieg teste diesen Code:


Code:
Sub Lampen()
Dim rng As Range
lr = Sheets("Suchwörter").Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To lr
   Such = Sheets("Suchwörter").Cells(i, "A")
   Set rng = Sheets("Daten").Cells.Find("*" & Such & "*", LookIn:=xlValues, LookAt:=xlPart)
   If Not rng Is Nothing Then
       If Sheets("Suchwörter").Cells(i, "B") <> "Ok" Then
           Sheets.Add after:=Sheets(Sheets.Count)
           Sheets(Sheets.Count).Name = WorksheetFunction.Proper(Such)
           Sheets("Suchwörter").Cells(i, "B") = "Ok"
       End If
       
       Anf = rng.Address
       Do
       Debug.Print rng.Row
       Sheets("Daten").Rows(rng.Row).EntireRow.Copy Sheets(Such).Cells(Rows.Count, "A").End(xlUp).Offset(1)
       Set rng = Sheets("Daten").Cells.FindNext(rng)
       Loop Until rng.Address = Anf
   End If
Next i
End Sub

mfg
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste