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
#11
Hallo,

änder doch einfach Tabelle1 in Tabelle2 um.

Wenn Du etwas anderes ereichen möchtest, dann solltest Du erneut eine passende Beispieldatei einstellen.
Gruß Atilla
Antworten Top
#12
Danke für die schnelle Antwort Blush


So hier ist das Beispiel.

Thx !


Angehängte Dateien
.xlsm   Makro.xlsx.xlsm (Größe: 29,2 KB / Downloads: 7)
Antworten Top
#13
Hallo,

da hast Du aber einige Änderungen gemacht in der Datei.

Man muss im Code natürlich auch die Bereiche neu Anpassen und nicht nur die Tabellen:

Code:
Sub prcX2()
   Dim rngSuche As Range
   Dim lngLastRow As Long, lngC As Long
   Dim strArt As String, strAdresse As String
  
   With Worksheets("Tabelle2")
      'die Daten aus dem Auswertebereich löschen
      .Cells(15, 7).Resize(.Cells(15, 7).End(xlDown).Row - 14, 6).ClearContents
      'Schleife für den Suchwert und -/+ 10
      For lngC = -10 To 10
         'der Wert wird im Zellbereich E5:N16 gesucht
         Set rngSuche = Worksheets("Tabelle1").Range("E5:N16").Find(What:=.Range("E7") + 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, 7).End(xlUp).Row + 1
               ' ... und in die Tabelle eingetragen
               .Cells(lngLastRow, 7).Value = rngSuche.Value
               .Cells(lngLastRow, 8).Value = IIf(rngSuche.Column < 10, "X", "Y")
               .Cells(lngLastRow, 9).Value = Worksheets("Tabelle1").Cells(4, rngSuche.Column).Value
               .Cells(lngLastRow, 10).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, 11).Value = strArt
               .Cells(lngLastRow, 12).Value = .Cells(rngSuche.Row, 4).Value
               'Suche nach einen weiteren Treffer
               Set rngSuche = Worksheets("Tabelle1").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ß Atilla
[-] Folgende(r) 1 Nutzer sagt Danke an atilla für diesen Beitrag:
  • ECM25
Antworten Top
#14
Es Funktioniert!! :19:

Danke!
Antworten Top
#15
Ist es möglich in die Range.Find Methode noch extra Suchkriterien einzubauen?
Ich möchte die Ausgabe noch extra Filtern.


Find(What:=.Range("E7 Or D7") so eine Schreibweise funktioniert leider nicht. Blush

Zitat:Sub prcX2()
Dim rngSuche As Range
Dim lngLastRow As Long, lngC As Long
Dim strArt As String, strAdresse As String

With Worksheets("Tabelle2")
'die Daten aus dem Auswertebereich löschen
.Cells(15, 7).Resize(.Cells(15, 7).End(xlDown).Row - 14, 6).ClearContents
'Schleife für den Suchwert und -/+ 10
For lngC = -10 To 10
'der Wert wird im Zellbereich E5:N16 gesucht
Set rngSuche = Worksheets("Tabelle1").Range("E5:N16").Find(What:=.Range("E7") + 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, 7).End(xlUp).Row + 1
' ... und in die Tabelle eingetragen
.Cells(lngLastRow, 7).Value = rngSuche.Value
.Cells(lngLastRow, 8).Value = IIf(rngSuche.Column < 10, "X", "Y")
.Cells(lngLastRow, 9).Value = Worksheets("Tabelle1").Cells(4, rngSuche.Column).Value
.Cells(lngLastRow, 10).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, 11).Value = strArt
.Cells(lngLastRow, 12).Value = .Cells(rngSuche.Row, 4).Value
'Suche nach einen weiteren Treffer
Set rngSuche = Worksheets("Tabelle1").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
Antworten Top
#16
Hallo,

was heißt extra filtern? Steht jetzt der Suchwert in E7 oder in D7? Und von was hängt es ab, wo der Suchwert steht?
Gruß Stefan
Win 10 / Office 2016
Antworten Top
#17
So hier das Beispiel :)


Angehängte Dateien
.xlsm   Makro.xlsx (2).xlsm (Größe: 32 KB / Downloads: 3)
Antworten Top
#18
Hallo,

mir scheint, Du hast den Ausgabebereich wieder verändert.

Code:
Sub prcX2()
   Dim rngSuche As Range
   Dim lngLastRow As Long, lngC As Long
   Dim strArt As String, strAdresse As String
  
   With Worksheets("Tabelle2")
      'die Daten aus dem Auswertebereich löschen
      .Cells(2, 7).Resize(.Cells(2, 7).End(xlDown).Row - 1, 6).ClearContents
      'Schleife für den Suchwert und -/+ 10
      For lngC = -10 To 10
         'der Wert wird im Zellbereich E5:N16 gesucht
         Set rngSuche = Worksheets("Tabelle1").Range("E5:N16").Find(What:=.Range("B6") + 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
               If Worksheets("Tabelle1").Cells(4, rngSuche.Column).Value = .Cells(6, 4).Value And _
               (.Cells(6, 3).Value = "X" And rngSuche.Column < 10 Or .Cells(6, 3).Value = "Y" And rngSuche.Column > 9) Then
                  '... und die erste freie Zelle im Auswertebereich gesucht....
                  lngLastRow = .Cells(.Rows.Count, 7).End(xlUp).Row + 1
                  ' ... und in die Tabelle eingetragen
                  .Cells(lngLastRow, 7).Value = rngSuche.Value
                  .Cells(lngLastRow, 8).Value = IIf(rngSuche.Column < 10, "X", "Y")
                  .Cells(lngLastRow, 9).Value = Worksheets("Tabelle1").Cells(4, rngSuche.Column).Value
                  .Cells(lngLastRow, 10).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, 11).Value = strArt
                  .Cells(lngLastRow, 12).Value = .Cells(rngSuche.Row, 4).Value
                  'Suche nach einen weiteren Treffer
               End If
               Set rngSuche = Worksheets("Tabelle1").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
#19
Super! :)

Gibt es keine Möglichkeit zu bestimmen in welchen Bereich der Tabelle die Ausgabe anfangen Soll?
Wenn ich z.B. möchte, dass die Ausgabe ab einem bestimmten Zeilen und Spalten Abstand beginne soll?

Ich weiß z.B. das mit .Cells(lngLastRow, 7).Value Die Ausgabe ab Spalte 7 beginnt. Jedoch der Zeilen Abstand wird ja automatisch durch die Variable vorgegeben, die oben im Code automatisch mit Zeilen gefüttert wird.

MFG
Antworten Top
#20
Hi,

dann schreibe halt in die Formel rein:

.Cells(lngLastRow + 10, 7).Value

oder schreibe vorher:
lngLastRow = lngLastRow + 10
[-] Folgende(r) 1 Nutzer sagt Danke an Rabe für diesen Beitrag:
  • ECM25
Antworten Top


Gehe zu:


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