Ergebnis 1 bis 8 von 8
  1. #1
    Registriert seit
    20.07.2018
    Beiträge
    7

    VBA - Zelle daneben ausgeben

    Hallo zusammen,

    ich habe mal wieder ein Problem mit einem VBA Script. Vielleicht kann mich hier nochmal jemand unterstützen.

    Folgendes Szenario:
    Ich habe 2 Tabellen. In Tabelle 2 befindet sich eine Liste mit Suchbegriffen in Spalte A, in Spalte B steht in Tabelle 2 neben dem Suchbegriff ein Text.
    Ich möchte nun in Tabelle 1 Spalte A nach den Suchbegriffen aus Tabelle 2 Spalte A suchen. Wenn der Suchbegriff gefunden wird, soll die Zelle rechts neben dem gefunden Suchbegriff aus Tabelle 2 (also Spalte B) in Tabelle 1 in Spalte F geschrieben werden.

    Folgendes Script habe ich mir aus dem Netz zusammen gebastelt. Die Suchbegriffe werden mit diesem Script, bei einem Treffer, in Spalte F geschrieben. Das funktioniert soweit. Ich bekomme es aber leider nicht hin, die Spalte neben dem Suchbegriff auszugeben. Irgendwie funktionieren meine Versuche mit Offset leider alle nicht.

    Das Script sieht wie folgt aus:

    Code:
    Sub x()
    Dim rng As Range
    Dim Liste As Variant
    Dim lngI As Long
    
    Liste = Sheets(2).Range("A1:A" & Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row)
    
    For lngI = LBound(Liste) To UBound(Liste)
        Set rng = Sheets(1).Range("A:A").Find(What:=Liste(lngI, 1), LookIn:=xlValues, lookat:=xlPart)
        ActiveCell.Offset(0, 1).Select
        If Not rng Is Nothing Then
            Sheets(1).Cells(rng.Row, 6).Value = Liste(lngI, 1)
        End If
    Next lngI
    End Sub
    Vielleicht kann mir jemand ein Beispiel geben, wie das ganze richtig aussehen sollte und wo ggf. der Offset eingebaut werden muss?

    Für eure Unterstützung bedanke ich mich im Voraus.

    LG
    Alex

  2. #2
    Registriert seit
    25.07.2007
    Ort
    Zürich
    Beiträge
    6.144
    Hallo Alex

    Theoretisch lassen sich Daten aus anderen Blättern auch ohne Makro nachschlagen. Das da ist zwar ein anderer Anwendungsfall, aber vielleicht bringt er Dir nützliche Hinweise:
    https://www.pctipp.ch/tipps-tricks/k...enblatt-89690/

    Herzliche Grüsse
    Gaby
    Redaktion PCtipp
    ---------------
    *** PCtipp Heft oder E-Paper abonnieren ***
    *** Auf Facebook: PCtipp, Computerworld *** PCtipp auf Google+ und Twitter ***

  3. #3
    Registriert seit
    20.07.2018
    Beiträge
    7
    Hallo Gaby,

    vielen lieben Dank für den Tipp.

    Mein Beispiel ist nur rudimentär einfach dargestellt. Daher komme ich mit Index und Matrix glaube ich nicht weiter. Vor allem werden wöchtenlich immer wieder neue Daten in die Tabelle geschrieben. Da ist für mich ein Makro auf Dauer die bessere Lösung.

    Ich warte mal noch etwas ab, vielleicht hat ja jemand noch einen Vorschlag für ein Makro mit Offset für mich.

    Liebe Grüße
    Alex

  4. #4
    Registriert seit
    04.08.2015
    Ort
    in der Geburtsstadt der Gebrüder Grimm
    Beiträge
    227

    So:?

    Hallo Alex,

    mit einer leichten Änderung geht das.

    Code:
    Sub x()
        Dim rng As Range
        Dim Liste As Variant
        Dim lngI As Long
        
        Liste = Sheets(2).Range("A1:A" & Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row)
        
        For lngI = LBound(Liste) To UBound(Liste)
            Set rng = Sheets(1).Range("A:A").Find(What:=Liste(lngI, 1), LookIn:=xlValues, lookat:=xlPart)
            If Not rng Is Nothing Then Sheets(1).Cells(rng.Row, 6).Value = Sheets(2).Range("A" & lngI)
        Next lngI
    End Sub
    Und die Zeile mit dem Select habe ich rausgenommen. Die ist überflüssig.

    Grüße, Andreas

  5. #5
    Registriert seit
    09.08.2007
    Beiträge
    266
    Hallo Alex

    Ich hoffe, ich habe Dich richtig verstanden:
    In Tabelle1 wird Spalte A durchgecheckt.
    Wenn ein Wert aus Tabelle1/Spalte A identisch ist mit einem Wert aus Tabelle2/SpalteA, dann wird in Tabelle1/SpalteF der entsprechende Wert aus Tabelle2/Spalte B ausgegeben.

    Das macht folgendes Makro - etwas steinzeitlich; halt so, wie ich es von Hand auch machen würde.

    Code:
    Sub test()
    Dim lzt1%, lzt2%, i%, j%
    Dim spa$
    lzt1 = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
    lzt2 = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets(1)
        .Columns("F:F").ClearContents
        For i = 1 To lzt1
            spa = .Cells(i, 1)
            For j = 1 To lzt2
                If Sheets(2).Cells(j, 1) = spa Then
                    .Cells(i, 6) = Sheets(2).Cells(j, 2).Value
                End If
            Next j
        Next i
    End With
    End Sub
    Ich hoffe, das hilft Dir. Grüsse Niclaus

  6. #6
    Registriert seit
    20.07.2018
    Beiträge
    7
    Hallo zusammen,

    vielen Dank Andreas und Niclaus.

    Beide Scripte funktionieren einwandfrei. Bei Andreas seinem musst ich nur von Spalte A auf B ändern.

    Zwischenzeitlich habe ich auch nochmal rumprobiert und folgender Code führt auch zum gewünschten Ergebnis:

    Code:
    Sub Umschluesseln()
    Dim rng As Range
    Dim Liste As Variant
    Dim lngI As Long
    
    Liste = Sheets(2).Range("A1:B" & Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row)
    
    For lngI = LBound(Liste) To UBound(Liste)
        Set rng = Sheets(1).Range("A:A").Find(What:=Liste(lngI, 1), LookIn:=xlValues, lookat:=xlPart)
        If Not rng Is Nothing Then
            Sheets(1).Cells(rng.Row, 6).Value = Liste(lngI, 2)
        End If
    Next lngI
    End Sub
    Nochmals herzlichen Dank an alle für die Unterstützung.
    Geändert von Bakkashan (30.07.2019 um 21:09 Uhr)

  7. #7
    Registriert seit
    09.08.2007
    Beiträge
    266
    Hallo Andreas - da bin ich zu spät gekommen - Alex hat es schon bemerkt. ;-)
    Und löschen kann ich diesen Beitrag nicht

    Etwas müsste man noch ändern in Deinem Makro:

    Code:
    If Not rng Is Nothing Then Sheets(1).Cells(rng.Row, 6).Value = Sheets(2).Range("A" & lngI)
    sollte heissen
    If Not rng Is Nothing Then Sheets(1).Cells(rng.Row, 6).Value = Sheets(2).Range("B" & lngI)
    Also "B" anstelle von "A" - oder nicht?

    Viele Grüsse Niclaus

  8. #8
    Registriert seit
    04.08.2015
    Ort
    in der Geburtsstadt der Gebrüder Grimm
    Beiträge
    227

    Danke

    Ja Niclaus,
    du hast Recht. Ich habe A und B verwechselt. Sorry.
    Ich muss allerdings sagen, dass mir die letzte Version von Alex fast am besten gefällt. Das mit dem 2-dimensionalen Array hat was.

    Grüße, Andreas

Berechtigungen

  • Neue Themen erstellen: Nein
  • Themen beantworten: Nein
  • Anhänge hochladen: Nein
  • Beiträge bearbeiten: Nein
  •