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 !!!
Gibt es keinen, der mir da helfen kann?
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
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?
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.
Hmmm :s
Muss jetzt also VBA lernen
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.
L.G.
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
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.
Hallo,
besser wäre es, Du würdest die Fragen im Forum stellen.
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