Microsoft Excel

Herbers Excel/VBA-Archiv

String suchen und kopieren

Betrifft: String suchen und kopieren von: Daniel
Geschrieben am: 12.08.2008 14:55:09

Hallo,
ich bin ein VBA Neuling und der Makroaufzeichner bringt mich nicht weiter, da dieser immer selectiert und aktiviert.
Ich brauche ein etwas allgemeineren Code.

Ok was ich habe sind folgende Inputdaten:

.............A......B.........C.............D
1

2........."A2".."B2"..."C2"...###bla1###
........................................###bla2###

3........."A3".."B3"..."C3" ###bla3###

4........."A4".."B4"..."C4" ###bla4###
........................................###bla5###
........................................###bla6###

Outputdaten möchte ich folgendes haben: (gleiche Exceldatei, neues Excellsheet)

.....A.....B.......C......D
1

2 "A2" "B2" "C2" bla1
3 "A2" "B2" "C2" bla2

3 "A3" "B3" "C3" bla3

4 "A4" "B4" "C4" bla4
5 "A4" "B4" "C4" bla5
6 "A4" "B4" "C4" bla6

Meine Exceldatei habe ich mit diesem Script bearbeitet:


Sub first_step()
'
' first_step Makro
'
    Sheets("Tabelle3").Delete
    Sheets("Tabelle2").Name = "Output"
    Sheets("Tabelle1").Name = "Input"
End Sub



Das sind also meine Vorgaben.

Ich weiß jetzt leider nicht wie ich vernünftig nach dem String "###" suche, die Zeichen bis zum nächsten String "###" kopiere und in das nächste Sheet kopiere.
Dabei muß ich auch noch den Zeilenwechsel beachten und die Daten ("A2", "A3" usw) aus den ersten 3 Zellen auch kopieren.

Versteht Ihr was ich möchte?

  

Betrifft: AW: String suchen und kopieren von: Tobias
Geschrieben am: 12.08.2008 15:03:31

Hallo Daniel!

da dieser immer selectiert und aktiviert.



Gut erkannt. :-)

Hilft Dir dieser Quellcode weiter?

Sub KopiereOhneRaute()
    Dim shtInput As Worksheet, shtOutput As Worksheet

    Set shtInput = Sheets("Input")
    Set shtOutput = Sheets("Output")

    shtOutput.Range("C4") = Replace(shtInput.Range("C4"), "#", "")
End Sub

Code eingefügt mit Syntaxhighlighter 4.15


Schönen Gruß, Tobias
http://www.tobiasschmid.de/


  

Betrifft: AW: String suchen und kopieren von: Daniel
Geschrieben am: 12.08.2008 15:22:57

Hallo Tobias,
ich dank dir erstmal für deine Antwort.

Aber:
1. Wenn ich dein Code ausführen möchte erhalte ich ein Fehler, in der Zeile vor End Sub
2. Sollte die Range in dieser Zeile bei mir Range("D2:D1000") sein, da ich mehr als nur die 4 Zeilen zu kopieren habe.

3. Aber ich werde mir mal die Replace Funktion ansehen.

Gruß
Daniel


  

Betrifft: AW: String suchen und kopieren von: Daniel
Geschrieben am: 12.08.2008 15:28:35

Hi

auch an Anfänger folgender Tip.
bevor man anfängt, ein Makro zu schreiben, sollte man immer erst überlegen, wie man das Problem denn am schnellsten ohne Makro lösen würde.
denn oft ist es so, daß dieser Weg dann auch per Marko der einfachste und schnellste ist.

in diesm Fall würde man ohne Makro doch so vorgehen:

alle Daten mit Copy-Paste von "Input" nach "Output" übertragen und dann in Spalte D mit ERSETZEN alle # durch nichts ersezten und fertig.
ergibt als Makrocode:

Sheets("Input").Cells.Copy Destination:=Sheets("Output").cells(1,1)
Sheets("Output").Range("D:D").Replace What:="###", Replacement:="", lookat:=xlpart



so, jetzt müssen wir noch die Leeren spalten in den Spalten A-C durch mit den Werten darüber füllen, das geht dann so:
- Spalten A-C markieren
- über Bearbeiten GeheZu Inhalte alle Leeren Zellen selektieren.
- in die erste Leere Zelle die Forme reinschreiben "=A2" (also Wert aus Zelle 1 drüber)
- eingabe mit STRG+ENTER abschließen, um die Formel in alle selektierten Zellen zu übernehmen.
- anschließen noch mit Kopieren und INHALTE EINFÜGEN WERTE die Formeln durch Werte ersetzen

als MakroCode sieht das dann so aus (kann man natürlich auch aufzeichnen)

Sheets("Output").Range("A:C").SpecialCells(xlcelltypeBlanks).FormulaR1C1="=R[-1]C"
Sheets("Output").Range("A:C").Value = Sheets("Output").RANGE("A:C").Value



klar, beim Aufzeichnen wird der Code wegen den Selects und Activates etwas länger, aber ich hoffe, du erkennst, wie man das zusammenfassen kann.

Gruß, Daniel


  

Betrifft: AW: String suchen und kopieren von: Daniel
Geschrieben am: 12.08.2008 16:06:52

Hallo Daniel,
ich versuche gerade deine 1. beiden Codezeilen nachzuvollziehen.
Ich habe die gerade mal getestet und es wird alle kopiert und nicht nur Spalte D.

Dann ist da noch das Problem das ich In Spalte D, nach jedem gefundenen Element mit dem Suchstring eine neue Zeile erstellen muß, sowie jeweils das kopieren der Werte Spalte A-C in die neue Zeile.
Also so "einfach" wie du das darstellst ist es nicht.

Danke für deine Geduld und dein Bemühen
Daniel

PS: Und wenn ich deine Zeilen 3 und 4 in den Makro einbaue, erhalte ich ein Fehler in Zeile 4.


  

Betrifft: AW: String suchen und kopieren von: Daniel
Geschrieben am: 12.08.2008 16:17:32

HI

das mit dem "neue Zeile einfügen" wird aus deiner darstellung nicht so richtig ersichtlich und wurde in deiner Beschreibung auch nicht erwähnt.
hier wäre es besser, du erstellst eine Exceldatei, in der du von Hand den Vorher- und den Soll-Zustand möglichst wirklichkeitsgetreu darstellst.
diese Exceldatei lädst du dann hier hoch. Nur dann lassen sich auch Sinnvoll makros erkennen.

wenn du Feher in Makros hast, dann solltest du auch den vollständigen MakroCode mit hier reinstellen (möglchst als "Zitat" formatieren). und beschreiben in Welcher Zeile der Fehler auftritt und wie die Fehlermeldung heißt.
Nur dann kann man erkennen, wo der Fehler liegt.
Vielleicht hast du dich ja einfach bei den Sheetbenennungen vertippt?

Gruß, Daniel


  

Betrifft: AW: String suchen und kopieren von: Daniel
Geschrieben am: 12.08.2008 17:25:48

Hallo Daniel,
ok du hast recht und ich zeige mal was ich machen möchte.

https://www.herber.de/bbs/user/54545.xls

Es ist eine Exceldatei.
Im 1. Sheet landen die Daten, diese kann ich leider nicht beeinflusse.
Das 2. Sheet soll durch den Makro, aus dem 1. Sheet erstellt werden.
Das 3. Sheet ist nur zur vollständigkeithalber enthalten und muß noch nicht besprochen werden. Ich möchte nur den vollständigen Code zeigen, daher auch was damit gemacht werden soll.

Gruß
Daniel

Mein Code:
"bla" heißt meine gesamte Funktion in den ich die einzellnen Prozeduren starte.

Sub first_step()
'
' first_step Makro
'
    Sheets("Tabelle3").Delete
    Sheets("Tabelle2").Name = "Output"
    Sheets("Tabelle1").Name = "Input"
End Sub


Sub Spaltenbreite_Zeilenhöhe()
'
' Veränderung der Spaltenbreite und Anpassung der Zeilenhöhe

'   Spalte A
    Columns("A:A").ColumnWidth = 40
'   Spalte B
    Columns("B:B").ColumnWidth = 10
'   Spalte C
    Columns("C:C").ColumnWidth = 40
'   Spalte D
    Columns("D:D").ColumnWidth = 70
'   Zeilenhöhe anpassen
    Cells.EntireRow.AutoFit
End Sub


Sub Ueberschrift_kopieren()
'
' Überschrift kopieren
'
    Sheets("Output").Range("A1:D1").Value = Sheets("Input").Range("A1:D1").Value
    End Sub


Sub FoundTextGreen()
Dim blatt As Worksheet
Dim firstAddress As String
Dim gefunden As Range
Dim tofind As String

tofind = "Bezahlt"
For Each blatt In Worksheets
With blatt.Range("D:D")
    Set gefunden = .Find(What:=tofind, LookIn:=xlValues, LookAt:=xlPart)
    If Not gefunden Is Nothing Then
        firstAddress = gefunden.Address
            Do
                gefunden.Columns.Interior.ColorIndex = 4
                Set gefunden = .FindNext(gefunden)
            Loop While Not gefunden Is Nothing And gefunden.Address <> firstAddress
        End If
    End With
Next
End Sub


Sub FoundTextYellow()
Dim blatt As Worksheet
Dim firstAddress As String
Dim gefunden As Range
Dim tofind As String

tofind = "Offen"
For Each blatt In Worksheets
With blatt.Range("D:D")
    Set gefunden = .Find(What:=tofind, LookIn:=xlValues, LookAt:=xlPart)
    If Not gefunden Is Nothing Then
        firstAddress = gefunden.Address
            Do
                gefunden.Columns.Interior.ColorIndex = 6
                Set gefunden = .FindNext(gefunden)
            Loop While Not gefunden Is Nothing And gefunden.Address <> firstAddress
        End If
    End With
Next
End Sub


Sub FoundTextRed()
Dim blatt As Worksheet
Dim firstAddress As String
Dim gefunden As Range
Dim tofind As String

tofind = "Mahnung"
For Each blatt In Worksheets
With blatt.Range("D:D")
    Set gefunden = .Find(What:=tofind, LookIn:=xlValues, LookAt:=xlPart)
    If Not gefunden Is Nothing Then
        firstAddress = gefunden.Address
            Do
                gefunden.Columns.Interior.ColorIndex = 3
                Set gefunden = .FindNext(gefunden)
            Loop While Not gefunden Is Nothing And gefunden.Address <> firstAddress
        End If
    End With
Next
End Sub


'####################

Sub bla()
'
    Call first_step
    Sheets("Output").Select
    Call Spaltenbreite_Zeilenhöhe
    Sheets("Input").Select
    Call Spaltenbreite_Zeilenhöhe
    Call Ueberschrift_kopieren
   ' Call FoundTextGreen
   ' Call FoundTextYellow
   ' Call FoundTextRed
End 

Sub                     '####################



  

Betrifft: AW: sorry, ich bin draussen von: Daniel
Geschrieben am: 12.08.2008 22:55:05

Hi
da hast du ja ne sehr komplexe aufgabe bekommen.
ich hoffe, du erkennst den Unterschied zwischen deinem ersten Beispiel und dem, was du jetzt hochgeladen hast.
das komplett zu lösen ist nicht gerade trivial und übersteigt daß, was ich unter "Nachbarschaftshilfe" verstehe deutlich.
such dir nen Profi vor Ort, der dich berät oder beauftrage ihn ganz mit der Aufgabe, weil ohne exakte Kenntnisse der Originaldaten (die du hier kaum veröffentlichen wirst), sehe ich da keine Möglichkeit was zu machen.

das einzige was ich dir raten kann, falls du vorhast, dieses Problem selbst zu lösen, mach dich mal intensiv mit den ganzen Sting-Funktionen vertraut, LEFT, RIGHT, MID, INSTR, INSTRREV, REPLACE, weil die Schwierigkeit wird hier sein, in den Spalten B und C zu erkennen, in wieviele Einzeldatensätze die einzelnen Zellen zu zerlegen sind und welches die Relevanten Daten sind.

Gruß, Daniel


  

Betrifft: AW: sorry, ich bin draussen von: Daniel
Geschrieben am: 13.08.2008 07:06:45

Danke Daniel,
das reicht erstmal.

Wenn ich weiß was es für Befehle gibt, mit den ich handtieren muß, ist das schon nicht mehr so kompliziert.

Gruß
Daniel


 

Beiträge aus den Excel-Beispielen zum Thema "String suchen und kopieren"