String suchen und kopieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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                     '####################

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

String suchen und kopieren

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread