Antworten und eine Beispielarbeitsmappe zu Fragen zum Thema "Suchen" finden Sie hier: Hier klicken

Suchen und "*" dranhängen

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

Suchen und "*" dranhängen

Suchen und "*" dranhängen von Chris vom 30.07.2014 07:15:25

AW: Suchen und "*" dranhängen - von Robert am 30.07.2014 07:32:58
- AW: Suchen und "*" dranhängen - von Chris am 30.07.2014 08:36:27
  - AW: Suchen und "*" dranhängen - von Robert am 30.07.2014 08:44:25
AW: Suchen und "*" dranhängen - von Beverly am 30.07.2014 07:42:06
- AW: Suchen und "*" dranhängen - von Chris am 30.07.2014 08:30:52
  - AW: Suchen und "*" dranhängen - von Robert am 30.07.2014 08:35:34
AW: Suchen und "*" dranhängen - von Hajo_Zi am 30.07.2014 07:45:08
- AW: Suchen und "*" dranhängen - von Chris am 30.07.2014 08:33:47
  - AW: Suchen und "*" dranhängen - von Hajo_Zi am 30.07.2014 08:36:59
noch ein Vorschlag - von Erich G. am 30.07.2014 08:34:18
- AW: noch ein Vorschlag - von Chris am 30.07.2014 10:59:06
  - unklar - von Erich G. am 31.07.2014 12:25:11
Korrektur - von Erich G. am 30.07.2014 08:46:43

Betrifft: Suchen und "*" dranhängen von: Chris
Geschrieben am: 30.07.2014 07:15:25

Hallo VBAler,

ich möchte per VBA folgendes lösen.

Zwei Worksheets.:

Wenn in WKSI(Tabelle1) in irgendeiner Zelle in Spalte D "((AKTIV))" steht, soll Excel den entsprechenden Eintrag der Zelle, welche in Spalte A steht (Offset,-3), in WKS2 (Tabelle2), Spalte A, suchen und dort am Ende des Eintrages ein "*" dranhängen.

Bei beiden Worksheets ist der Range variabel und soll jeweils von unten durchsucht werden .end(xlup)...

Zum besseren Verständnis haben ich eine Beispielmappe hochgeladen.

https://www.herber.de/bbs/user/91774.xlsm

Danke,

Chris

Betrifft: AW: Suchen und "*" dranhängen von: Robert
Geschrieben am: 30.07.2014 07:32:58

Hallo Chris

In die Arbeitsmappe:

Option Explicit

Dim i, o As Integer

Private Sub Test()
For i = Tabelle1.UsedRange.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
    If Tabelle1.Cells(i, 4) = "((AKTIV))" Then
            For o = Tabelle2.UsedRange.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
                If Tabelle2.Cells(o, 1) = Tabelle1.Cells(i, 1) Then
                    Tabelle2.Cells(o, 1) = Tabelle2.Cells(o, 1) & "*"
                End If
            Next o
    End If
Next i
End Sub

Betrifft: AW: Suchen und "*" dranhängen von: Chris
Geschrieben am: 30.07.2014 08:36:27

Danke Robert - läuft bestens. Ich versuche das makro nachzuvollziehen.

Gruß

Chris

Betrifft: AW: Suchen und "*" dranhängen von: Robert
Geschrieben am: 30.07.2014 08:44:25

Hallo Chris,

Dann will ich mal nicht so sein ;)

Die erste For-Next Schleife läuft von der letzten benutzen Zeile in Tabelle1 zurück zu Zeile 1

For i = Tabelle1.UsedRange.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1

Wenn nun in Zeile i, Spalte D(4) dein "((AKTIV))" steht

If Tabelle1.Cells(i, 4) = "((AKTIV))" Then

Dann sucht er in jeder verwendeten Zeile in Tabelle2, von unten nach oben (2. Schleife)

For o = Tabelle2.UsedRange.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1

Wenn er in Spalte A, Tabelle2 den gleichen Wert findet wie in Spalte A, Tabelle1

If Tabelle2.Cells(o, 1) = Tabelle1.Cells(i, 1) Then

Dann hängt er an den Wert in Tabelle2, Spalte A dein * dran

Tabelle2.Cells(o, 1) = Tabelle2.Cells(o, 1) & "*"

Hoffe das hilft :)

Viele Grüße
Robert

Betrifft: AW: Suchen und "*" dranhängen von: Beverly
Geschrieben am: 30.07.2014 07:42:06

Hi Chris,

das geht m.E. nur, wenn die Anzahl und die Reihenfolge der Inhalte in Spalte A in beiden Tabellen identisch ist:

Sub Vergleichen()
   Dim lngZeile As Long
   Dim lngLetzte1 As Long
   Dim lngLetzte2 As Long
   lngLetzte1 = IIf(IsEmpty(Cells(Rows.Count, 1)), _
      Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
   With Worksheets("Tabelle2")
      lngLetzte2 = IIf(IsEmpty(.Cells(.Rows.Count, 1)), _
         .Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
      For lngZeile = lngLetzte1 To 1 Step -1
         If Cells(lngZeile, 4) = "((AKTIV))" Then _
            .Cells(lngLetzte2, 1) = .Cells(lngLetzte2, 1) & "*"
         lngLetzte2 = lngLetzte2 - 1
      Next lngZeile
   End With
End Sub

Betrifft: AW: Suchen und "*" dranhängen von: Chris
Geschrieben am: 30.07.2014 08:30:52

Hallo Karin,

danke läuft. Die Reihenfolge und Anzahl sind identisch. Wenn dies nicht so wäre, wieso ginge das dann nicht.

Betrifft: AW: Suchen und "*" dranhängen von: Robert
Geschrieben am: 30.07.2014 08:35:34

Hallo Chris,

Weil Karins Code nur eine Schleife macht, um die "((Aktiv))" zu finden und dann davon ausgeht, dass in Tabelle2 der Datensatz in derselben Zeile steht.

Soll es davon unabhängig funktionieren, muss man eine zweite Schleife einbauen, die den richtigen Datensatz in Tabelle 2 sucht.

Siehe mein Beitrag weiter oben, da sind 2 Schleifen drin und es funktioniert auch wenn Tabelle2 eine andere Reihenfolge hat.

Viele Grüße
Robert

Betrifft: AW: Suchen und "*" dranhängen von: Hajo_Zi
Geschrieben am: 30.07.2014 07:45:08

Hallo Chris,

Option Explicit

Public Sub Find_Methode()
    Dim WsSheet1 As Worksheet
    Dim WsSheet2 As Worksheet
    Dim Rafound As Range
    Dim StAdresse As String
    Dim sSuchbegriff  As String
    Dim LoI As Long
    Dim LoLetzte As Long
    Set WsSheet1 = ThisWorkbook.Worksheets("Tabelle1")
    Set WsSheet2 = ThisWorkbook.Worksheets("Tabelle2")
    LoLetzte = IIf(IsEmpty(WsSheet1.Cells(Rows.Count, 1)), WsSheet1.Cells(Rows.Count, 1).End( _
xlUp).Row, Rows.Count)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    For LoI = 1 To LoLetzte
        If WsSheet1.Cells(LoI, 4) = "((AKTIV))" Then
            'Set WkSh_1 = ThisWorkbook.Worksheets("Sicherung_Telefonliste")
            With WsSheet2.Columns(1)
                Set Rafound = .Find(What:=WsSheet1.Cells(LoI, 1), LookAt:=xlWhole, LookIn:= _
xlValues)
                If Not Rafound Is Nothing Then
                    StAdresse = Rafound.Address
                    Do
                        Rafound = Rafound & "*"
                        Set Rafound = .FindNext(Rafound)
                        If Rafound Is Nothing Then
                            Exit Do
                        End If
                    Loop While Rafound.Address <> StAdresse
                End If
            End With
        End If
    Next LoI
    Application.EnableEvents = True
    Application.CutCopyMode = False         'Zwischenspeicher löschen
    Application.ScreenUpdating = True
    Set WsSheet1 = Nothing
    Set WsSheet2 = Nothing
    Set Rafound = Nothing
End Sub

Betrifft: AW: Suchen und "*" dranhängen von: Chris
Geschrieben am: 30.07.2014 08:33:47

Hallo Hajo,

danke für das Makro - läuft. Viel Makro für ein simples Verfahren :-)

Mal eine Verständnisfrage: Schreibst du sowas mal eben während des Frühstücks nebenbei oder ist das hier COPY-Paste von einer anderen Sache.....

Nochmals Danke,

Chris

Betrifft: AW: Suchen und "*" dranhängen von: Hajo_Zi
Geschrieben am: 30.07.2014 08:36:59

Hallo Chris,

ich bin nun schon zig Jahre im Forum. Da wird oft vorhandenes angepasst.

Gruß Hajo

Betrifft: noch ein Vorschlag von: Erich G.
Geschrieben am: 30.07.2014 08:34:18

Hi Chris,
probier mal

Option Explicit

Sub Sternchen()
   Dim arQ, arZ, zz As Long

   With Worksheets("Tabelle1")
      arQ = .Cells(1, 4).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 1)
   End With

   With Worksheets("Tabelle2")
      arZ = .Cells(1, 1).Resize(UBound(arQ))
      For zz = 1 To UBound(arQ)
         If arQ(zz, 1) = "((AKTIV))" Then
            arZ(zz, 1) = arZ(zz, 1) & "*"
         Else
            arZ(zz, 1) = CStr(arZ(zz, 1))
         End If
      Next zz
      .Columns(1).NumberFormat = "@"
      .Cells(1, 1).Resize(UBound(arQ)) = arZ
   End With
End Sub

In Tabelle2!A:A werden hier einheitlich Texte geschrieben - es entsteht kein Mischmasch aus Zahlen und Texten.

"und soll jeweils von unten durchsucht werden": Warum? Spielt das hier eine Rolle?

In Tabelle1!D1 der BeiSpielMappe könnte eine Klammer fehlen... :-)

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Betrifft: AW: noch ein Vorschlag von: Chris
Geschrieben am: 30.07.2014 10:59:06

Hallo Erich,

ja, es spielte eine Rolle, da in Spalte A ziemlich viele Zahlen untereinander stehen und Excel prüft, ob eine bestimmte Zahl schon mal vorgekommen ist, um dies zu umgehen, setze ich einfach ein * hinter jede Zahl, somit findet der SVerweis keine Übereinstimmung. Klappt auch wunderbar.

Nun habe ich hier gleich mehrere Makros bekommen, die alle irgendwie das gleiche machen. Am besten verstehen, tue ich allerdings nur das von Robert, der sich die Mühe gemacht hat, mir jede Zeile zu erklären.

Kannst du mir dein Makro auch erklären ? Zeile für Zeile ...Ubound?Cstr?
übrigens: Die F1-Hilfe von VBA hilft mir persönlich zu 98% so überhaupt nicht, weiss nicht, wie es anderen geht.
Gruß und Danke,

Chris

Betrifft: unklar von: Erich G.
Geschrieben am: 31.07.2014 12:25:11

Hi Chris,
deine Antwort verstehe ich nicht wirklich. Vielleicht hast du hier auch einfach nur zu wenige Infos preisgegeben.

"Excel prüft, ob eine bestimmte Zahl schon mal vorgekommen ist": Wo? Wie? Excel? Oder du mittels Formel?
"findet der SVerweis keine Übereinstimmung": Was für ein SVERWEIS? Kam hier noch nicht vor...

Wie auch immer: Es bleibt egal, in welcher Reihenfolge die Sterne gerechnet werden.

Zum Code:
arQ ist ein Array, das die Quelldaten aus Tabelle1!D:D aufnimmt.
arZ ist ein Array für die Daten aus Tabelle2!A:A (vor und nach der Änderung).
zz ist eine laufende Nummer, wie eine Zeilennummer.
UBound(arQ) ist die Anzahl der Zeilen des Arrays arQ. Mit
arZ = .Cells(1, 1).Resize(UBound(arQ))
wird erreicht, dass arZ dieselbe Anzahl Zeilen wie arQ hat.

Was an der Funktion CStr(x) kann man verstehen, was nicht? Die Funktion gibt eine Zeichenkette/einen Text/String zurück,
der aus dem Argument x (ein Ausdruck, z. B. eine Zahl) entsteht.

Bei so allgemeinen Bitten um Erklärungen tut man sich immer schwer. Wo soll man anfangen?
Ein Beispiel aus diesem Zusammnhang: Ist klar, was ein Array ist?
Besser wäre es, du würdest konkrete Fragen stellen, aus denen auch gleich hervorgeht, was klar ist. :-)

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Betrifft: Korrektur von: Erich G.
Geschrieben am: 30.07.2014 08:46:43

Hi Chris,
sorry, da war noch ein kleiner Fehler drin:

Statt
arQ = .Cells(1, 4).Resize(.Cells(.Rows.Count, 1).End(xlUp).Row, 1)
soll da stehen:
arQ = .Cells(1, 4).Resize(.Cells(.Rows.Count, 4).End(xlUp).Row, 1)

Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich