Anzeige
Archiv - Navigation
640to644
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
640to644
640to644
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

text suchen und in andere zelle kopieren

text suchen und in andere zelle kopieren
26.07.2005 11:30:48
alex
Ich habe in der Spalte A 10.000 Zellen. darin sind bei 50% folgende Textzeilen(immer die letzte Zeile in jeder Zelle) mit dem Anfang texto:irgendwas enthalten ich möchte diese Zeilen automatisch finden, herauskopieren und in die danebenligende Spalte automatisiert hinüber kopieren.
Hab schon viele dinge probiert mit suchen, finden, vom Macrorecorder was abschauen usw. - bin aber letztlich erfolglos geblieben. bitte um hilfe!

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: text suchen und in andere zelle kopieren
26.07.2005 11:34:49
Unbekannter
Musst es nur noch mit den zellen anpassen.

Sub kopieren()
Dim c As Range
Dim ersterFundort As String
Dim gleich As Boolean
With Range("h:h")
Set c = .Find(What:="texto:")
If Not (c Is Nothing) Then
ersterFundort = c.Address
Do
gleich = Vergleich_Zeile(c.Row, c.Row - 1)
If gleich Then
Cells(c.Row - 1, 10).Value = "'" & Cells(c.Row, 9).Value
Else
gleich = Vergleich_Zeile(c.Row, c.Row + 1)
If gleich Then
Cells(c.Row + 1, 10).Value = "'" & Cells(c.Row, 9).Value
End If
End If
Set c = .FindNext(c)
Loop While Not (c Is Nothing) And c.Address <> ersterFundort
End If
End With
End Sub

Public

Function Vergleich_Zeile(aktZeile As Long, Zeile As Long) As Boolean
Dim I As Integer
Vergleich_Zeile = True
For I = 1 To 6
If Cells(aktZeile, I).Value <> Cells(Zeile, I).Value Then
Vergleich_Zeile = False
Exit For
End If
Next I
End Function

Anzeige
Anderes Makro
26.07.2005 11:38:01
Unbekannter
Das andere ist nicht für dich(habs falsche gegeben),das hier eher.

Sub kopieren()
ende = Cells(Rows.Count, 9).End(xlUp).Row  'die 9 ist die spalte
For I = ende To 2 Step -1
If Cells(I, 9) = "textto" Then        'hier auch
'hier deine zielort rein
End If
Next I
End Sub

grusß UN1

321 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige