Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Doppelte Werte suchen und die dan in die neue Tabelle automatisch einfügen
#1
Hallo Leute, :15:

Ich möchte gern einen Ausgegebenen Wert noch einmal in der Tabelle nach einen gleichen oder +-10 durchsuchen und diese dann in einer extra Tabelle automatisch einfügen.
Wie geht so etwas?

Vielen Dank für jede Hilfe !!!


Angehängte Dateien
.xlsx   Mappe2.xlsx (Größe: 14,97 KB / Downloads: 14)
Antworten Top
#2
Gibt es keinen, der mir da helfen kann?
Antworten Top
#3
Hallo,

in meinen Vorschlag wird bisher der Wert nur einmal gefunden. Sollte er ein zweites Mal auftauchen muss er dann auch aufgelistet werden?

Code:
Sub prcX()
   Dim rngSuche As Range
   Dim lngLastRow As Long, lngC As Long
   Dim strArt As String
  
   With Worksheets("Tabelle1")
      For lngC = -10 To 10
         Set rngSuche = .Range("E5:N16").Find(what:=.Range("P11") + lngC, LookIn:=xlValues, lookat:=xlWhole)
         If Not rngSuche Is Nothing Then
            lngLastRow = .Cells(.Rows.Count, 20).End(xlUp).Row + 1
            .Cells(lngLastRow, 20).Value = rngSuche.Value
            .Cells(lngLastRow, 21).Value = IIf(rngSuche.Column < 10, "X", "Y")
            .Cells(lngLastRow, 22).Value = .Cells(4, rngSuche.Column).Value
            .Cells(lngLastRow, 23).Value = "Option" & IIf(rngSuche.Row < 10, "1", "2")
            Select Case rngSuche.Row
               Case 5 To 7, 11 To 13
                  strArt = "Art1"
               Case Else
                  strArt = "Art2"
            End Select
            .Cells(lngLastRow, 24).Value = strArt
            .Cells(lngLastRow, 25).Value = .Cells(rngSuche.Row, 4).Value
         End If
      Next lngC
   End With

End Sub

Nachtrag: Jetzt wird jeder Treffer aufgelistet.

Code:
Sub prcX2()
   Dim rngSuche As Range
   Dim lngLastRow As Long, lngC As Long
   Dim strArt As String, strAdresse As String
  
   With Worksheets("Tabelle1")
      For lngC = -10 To 10
         Set rngSuche = .Range("E5:N16").Find(what:=.Range("P11") + lngC, LookIn:=xlValues, lookat:=xlWhole)
         If Not rngSuche Is Nothing Then
            strAdresse = rngSuche.Address
            Do
               lngLastRow = .Cells(.Rows.Count, 20).End(xlUp).Row + 1
               .Cells(lngLastRow, 20).Value = rngSuche.Value
               .Cells(lngLastRow, 21).Value = IIf(rngSuche.Column < 10, "X", "Y")
               .Cells(lngLastRow, 22).Value = .Cells(4, rngSuche.Column).Value
               .Cells(lngLastRow, 23).Value = "Option" & IIf(rngSuche.Row < 10, "1", "2")
               Select Case rngSuche.Row
                  Case 5 To 7, 11 To 13
                     strArt = "Art1"
                  Case Else
                     strArt = "Art2"
               End Select
               .Cells(lngLastRow, 24).Value = strArt
               .Cells(lngLastRow, 25).Value = .Cells(rngSuche.Row, 4).Value
               Set rngSuche = .Range("E5:N16").FindNext(rngSuche)
            Loop While rngSuche.Address <> strAdresse
         End If
      Next lngC
   End With

End Sub
Gruß Stefan
Win 10 / Office 2016
[-] Folgende(r) 1 Nutzer sagt Danke an Steffl für diesen Beitrag:
  • ECM25
Antworten Top
#4
Hi :)

Vielen Dank für deine Hilfe.
Und ja, falls der Wert mehrmals in der gesuchten Tabelle auftaucht, so sollen alle in die andere Tabelle aufgelistet werden.
Ich bin leider kein Excel Experte, soweit ich sehen kann, arbeitest du da an einem Makro?

Gibt es andere Möglichkeiten?
Ich meine, ohne ein Makro zu benutzen?
Antworten Top
#5
Hallo,

ja, das was ich gepostet habe ist ein Makro. Wie und wo Du das Makro einfügen mußt, wird dir hier gezeigt.

Ob es hier eine Lösungsmöglichkeit mit einer Formel gibt? Ich habe keine Ahnung. Undecided
Gruß Stefan
Win 10 / Office 2016
Antworten Top
#6
Hmmm :s

Muss jetzt also VBA lernen Dodgy

Danke!!!
Ich habe nun den Makro drin.
Jetzt ist die Frage wie das ganze Funktioniert? Hast du zufällig eine Liste was einzelne Befehle Bedeuten?

Es gibt leider noch ein Problem mit der erneuten Auswahl.
Bei neuem Wert in Zelle "P11" werden die alten Werte aus der Tabelle nicht überschrieben, Sie werden einfach in die nächsten Zeilen darunter eingefügt.
Kann man das nicht ändern?
Bei neuer Auswahl sollen neue Werte die alten ersetzen. Blush
L.G.
Antworten Top
#7
Hallo,

ich habe die Löschzeile in das Makro eingefügt und das Makro selber ein wenig kommentiert. Ich hoffe, es reicht dir.

Code:
Sub prcX2()
   Dim rngSuche As Range
   Dim lngLastRow As Long, lngC As Long
   Dim strArt As String, strAdresse As String
  
   With Worksheets("Tabelle1")
      'die Daten aus dem Auswertebereich löschen
      .Cells(18, 20).Resize(.Cells(17, 20).End(xlDown).Row - 17, 6).ClearContents
      'Schleife für den Suchwert und -/+ 10
      For lngC = -10 To 10
         'der Wert wird im Zellbereich E5:N16 gesucht
         Set rngSuche = .Range("E5:N16").Find(what:=.Range("P11") + lngC, LookIn:=xlValues, lookat:=xlWhole)
         'wenn es einen Treffer gibt....
         If Not rngSuche Is Nothing Then
            '...wird die Adresse des ersten Treffers in einer Variablen gespeichert....
            strAdresse = rngSuche.Address
            Do
               '... und die erste freie Zelle im Auswertebereich gesucht....
               lngLastRow = .Cells(.Rows.Count, 20).End(xlUp).Row + 1
               ' ... und in die Tabelle eingetragen
               .Cells(lngLastRow, 20).Value = rngSuche.Value
               .Cells(lngLastRow, 21).Value = IIf(rngSuche.Column < 10, "X", "Y")
               .Cells(lngLastRow, 22).Value = .Cells(4, rngSuche.Column).Value
               .Cells(lngLastRow, 23).Value = "Option" & IIf(rngSuche.Row < 11, "1", "2")
               Select Case rngSuche.Row
                  Case 5 To 7, 11 To 13
                     strArt = "Art1"
                  Case Else
                     strArt = "Art2"
               End Select
               .Cells(lngLastRow, 24).Value = strArt
               .Cells(lngLastRow, 25).Value = .Cells(rngSuche.Row, 4).Value
               'Suche nach einen weiteren Treffer
               Set rngSuche = .Range("E5:N16").FindNext(rngSuche)
            'und wiederhole es solange, bis der erste Treffer wieder gefunden wird
            Loop While rngSuche.Address <> strAdresse
         End If
      Next lngC
   End With

End Sub
Gruß Stefan
Win 10 / Office 2016
[-] Folgende(r) 1 Nutzer sagt Danke an Steffl für diesen Beitrag:
  • ECM25
Antworten Top
#8
Vielen Dank! :23:

Ich muss mich nun mit der VBA Sprache etwas auseinandersetzen.
Darf ich dir eine PN senden, falls da noch Fragen auftauchen?

L.G.
Antworten Top
#9
Hallo,

besser wäre es, Du würdest die Fragen im Forum stellen.
Gruß Stefan
Win 10 / Office 2016
Antworten Top
#10
Hallo :)


Ich habe mich nun mit VBA etwas länger beschäftigt und habe es herausgefunden, wie der Ablauf des Programms ungefähr geht.

Nun habe ich jedoch Fragen bezüglich der Ausgabe der Makros.
Die Makros können ja über eine Schaltfläche ausgegeben werden.

Bsp. Ich habe den gesuchten Wert nicht in Tabelle1 ("P11") sondern in Tabelle2.("P11").
Ich möchte nun mit Hilfe einer Schaltfläche den gesuchten Wert aus Tabelle2 in Tabelle2 ausgeben.
Auf Grund von With Worksheets("Tabelle1") wird der Makro in Tabelle2 nicht ausgeführt.
Wie kann man das ändern?


MFG
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste