|
Guten Tag liebe Programmierer,
ich habe bisher leider nur grobe Kenntnisse was das Programmieren in VBA angeht.
Ich habe bisher herumprobiert jedoch nur halbwegs mit Erfolg. Deshalb bin ich dankbar für jeden Lösungsansatz.
Ausgangssituation:
Ich habe eine Excel Datei mit drei Tabellen.
Tabelle 1 beinhaltet eine riesige Liste mit Datensätzen.
Tabellen 2 und 3 ist leer.
So und die Aufabe:
Das Programm soll in Tabelle 1 nach Zeilen suchen welche das bestimmte wort 'excel' beinhaltet.
Jede gefundene Zeile soll in Tabelle 2 eingefügt werden.
Dies ist mit folgendem Code erledigt:
************************
Sub FindenUndKopieren01()
Dim rng As Range ' variablen definition
Dim loDeinWert As String
Dim sFirstadress As String
loDeinWert = "excel" ' gesuchtes Wort
Set rng = Worksheets("Tabelle1").Range("A1:A189").find(loDeinWert) ' Range eingabe
If rng Is Nothing Then
MsgBox "Wort " & loDeinWert & " nicht gefunden!" ' Falls es nicht gefunden wird
Else
sFirstadress = rng.Address ' Range Addressierung
Do
rng.EntireRow.Copy ' Kopieren von Inhalt
'PROBLEM: Beim Ausführen wird die komplette Zelle überschrieben
'Also werden die in den nächsten Spalten stehenden Werte gelöscht
Worksheets("Tabelle2").Cells(Rows.Count, "A").End(xlUp) _
.Offset(1, 0).PasteSpecial Paste:=xlPasteAll ' Einfuegen in die zweite Tabelle
Columns(1).EntireColumn.AutoFit
Set rng = Worksheets("Tabelle1").Range("A:B").FindNext(rng)
Loop While Not rng Is Nothing And rng.Address <> sFirstadress ' Nichtgleich
End If
End Sub
************************************
nun der zweite Teil der Aufgabe besteht darin, nur die nächsten 4 Zeichen zu kopieren,
was nach dem wort 'excel' kommt und Tabelle 2 in Spalte C zu kopieren.
Das will einfach mit dem Vorherigen Code nicht klappen. Ein weiteres Problem ist das immer
eine ganze Zeile kopiert und eingefügt wird, das macht die Sache noch schwieriger.
Vielen Dank im Vorraus!! |