Anzeige
Archiv - Navigation
376to380
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
376to380
376to380
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Suchen-einfaerben-kopieren

Suchen-einfaerben-kopieren
07.02.2004 16:59:19
Timo
Nen schoenen Nachmittag allerseits.
Ich habe ein Problem und konnte im Forum keine aehnliche Frage finden.
Also ich dursuche z.B. die Spalte x, will aber das alle Zellen, die das Suchwort auch nur beinhalten (durch "ha" wird halle und auch hannover angesprochen), angesprochen werden.
Die Zeile bei denen die Spalte x den Wert "ha" beinhaltet sollen eingefaerbt werden (z.B. gelb).
Und nun sollen auch noch diese Zeilen in ein zweites Tabellenblatt kopiert werden.
Supervielen Dank,
Timo

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Suchen-einfaerben-kopieren
07.02.2004 17:21:48
Worti
Hallo Timo,
hier ein kleines Beispiel:


Sub Farbe_Copy()
    Dim As Integer
    Dim As Integer
    
    J = 1
    Worksheets(1).Select
    For I = 1 To 5
        If InStr(1, Cells(I, 1).Value, "Ha") > 0 Then
            Cells(I, 1).Interior.ColorIndex = 3
            Cells(I, 1).Copy Destination:= _
            Worksheets(2).Range("A" & J)
            J = J + 1
         End If
     Next
End Sub

     Code eingefügt mit Syntaxhighlighter 2.5

Worti
Anzeige
AW: Suchen-einfaerben-kopieren
07.02.2004 17:29:53
Timo
Hallo Worti,
erstaml vielen Dank!
Aber:
Muss ich an dem Code noch etwas aendern? Denn so laeufts nicht. Muss ich die Spalte wo gesucht werden soll, angeben??? (Das "ha" soll nur in der Spalte A gesucht werden).
Gruss,
Timo
AW: Suchen-einfaerben-kopieren
07.02.2004 17:38:50
Worti
Hallo Timo,
gesucht wird momentan in Spalte A von Zeile 1 bis 5.
Wenn du bis zum Ende un Spalte A suchen willst, muß du statt For I = 1 to 5 schreiben:
For I = 1 to Cells(Rows.Count,1).End(xlUp).Row
Dann noch deine Blattnamen eingeben, zB für WorkSheeets(1) schreibst du
worksheets("DeinSheet") (das in dem gesucht wird) und statt Worksheets(2) zum Beispiel Worksheets("Ziel") oder wie dein Blatt, wo hineinkopiert wird, heißt.
Worti
Anzeige
AW: Suchen-einfaerben-kopieren
07.02.2004 18:27:06
Timo
Danke Worti,
werde ich mal gleich ausprobieren.
Habe aber gerade den Putz-Befehl von Freundin bekommen!
Gruss,
Timo
AW: Suchen-einfaerben-kopieren
07.02.2004 18:48:01
Timo
Ja,
aber meine Daten sind in A1-A5 und da passiert gar nichts?
AW: Suchen-einfaerben-kopieren
07.02.2004 18:05:32
Josef Ehrensberger
Hallo Timo!
Probier mal diesen Code.
Die Namen der Tabellen und die Spalte musst Du anpassen!


Sub SuchenFaerbenKopieren()
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Dim rng As Range
Dim sFind As String
Dim sFirst As String
Dim lngR As Integer
sFind = InputBox("Suchbegriff", "Suchen", "?")
   If sFind = "" Then Exit Sub
Set wksQ = Sheets("Tabelle1")   'Name des Blattes das durchsucht wird - anpassen
Set wksZ = Sheets("Tabelle2")   'Name des Blattes in das kopiert wird - anpassen
lngR = wksZ.Range("A65536").End(xlUp).Row + 1
Set rng = wksQ.Range("A:A").Find(What:=sFind, After:=[A1], _
   LookIn:=xlValues, Lookat:=xlPart) 'Spalte in der gesucht wird - anpassen
   If Not rng Is Nothing Then
   sFirst = rng.Address
   rng.EntireRow.Copy wksZ.Cells(lngR, 1)
   lngR = lngR + 1
   rng.EntireRow.Interior.ColorIndex = 6 'ColorIndex 6 = gelb
      Do
      Set rng = wksQ.Range("A:A").FindNext(After:=rng) 'Spalte in der gesucht wird - anpassen
         If rng.Address = sFirst Then Exit Do
      rng.EntireRow.Copy wksZ.Cells(lngR, 1)
      lngR = lngR + 1
      rng.EntireRow.Interior.ColorIndex = 6
      Loop
   End If
End Sub

     Code eingefügt mit Syntaxhighlighter 2.5

Gruß Sepp
Anzeige
AW: Suchen-einfaerben-kopieren
07.02.2004 18:33:40
Timo
Danke Sepp!
Super fast perfekt,
ausser:
-die kopierten Spalten tauchen im 2. Blatt ohne erkennbare Rangfolge auf (nicht gleiche rangfolge wie im 1. Blatt).
-die erste Zeile des 2. Blattes wird freigelassen
Gruss,
Timo
AW: Suchen-einfaerben-kopieren
07.02.2004 19:07:28
Josef Ehrensberger
Hallo Timo!
Dann halt so.


Sub SuchenFaerbenKopieren()
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Dim rng As Range
Dim sFind As String
Dim sFirst As String
Dim lngR As Integer
sFind = InputBox("Suchbegriff", "Suchen", "?")
   If sFind = "" Then Exit Sub
Set wksQ = Sheets("Tabelle1")   'Name des Blattes das durchsucht wird - anpassen
Set wksZ = Sheets("Tabelle2")   'Name des Blattes in das kopiert wird - anpassen
lngR = wksZ.Range("A65536").End(xlUp).Row
Set rng = wksQ.Range("A:A").Find(What:=sFind, After:=[A65536], _
   LookIn:=xlValues, Lookat:=xlPart) 'Spalte in der gesucht wird - anpassen
   If Not rng Is Nothing Then
   sFirst = rng.Address
   rng.EntireRow.Copy wksZ.Cells(lngR, 1)
   lngR = lngR + 1
   rng.EntireRow.Interior.ColorIndex = 6 'ColorIndex 6 = gelb
      Do
      Set rng = wksQ.Range("A:A").FindNext(After:=rng) 'Spalte in der gesucht wird - anpassen
         If rng.Address = sFirst Then Exit Do
      rng.EntireRow.Copy wksZ.Cells(lngR, 1)
      lngR = lngR + 1
      rng.EntireRow.Interior.ColorIndex = 6
      Loop
   End If
End Sub

     Code eingefügt mit Syntaxhighlighter 2.5

Gruß Sepp
Anzeige
AW: Suchen-einfaerben-kopieren
07.02.2004 21:40:33
Timo
Hallo Sepp,
vielen Dank. Jetzt laeufts genauso wie ich es haben wollte. Danke!
Schoenen Abend,
Timo
Danke für die Rückmeldung! o.T.
07.02.2004 21:48:11
Josef Ehrensberger
Gruß Sepp

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige