markieren Dispo

GutenTag an alle,
ich habe ein Tabellenblatt mit dem Namen " FERTIG"
dazu ein Tabellenblatt "Lager",
Ich muss momentan im Tabellenblatt FERTIG in der Spalte A eine Artikelnummer markieren und dann in den Tabellenblatt Lager mit STRG H diese Artikelnummer ( Spalte D) suchen und dann gelb markieren.
Das ist bei 800Zeilen im Tabellenblatt FERTIG sehr aufwendig immer wieder zu dem anderen Tabellenblatt zu springen. Im Tabellenblatt Lager sind es 2500Zeilen da Artikelnummer doppelt vorkommen mit unterschiedliche Menge . Meine Idee aber leider wenig Ahnung von VBA.
Ich erstelle in der Zeile 1 einen Button im Tabellenblatt FERTIG.
jetzt selektiere ich eine Artikelnummer Spalte A drücke auf dem Button und anschließend sucht VBA diesen Art. im Tabellenblatt Lager und markiert in dann mit gelb Spalte D aber nur eine von den mehreren Artikelnummern.
Als Rückmeldung soll er mir dann die Menge der Markierte zeile melden,Spalte E.
Sollte ich danach nochmal den gleichen Artikel klicken muß er die zweite markieren mit Rückmeldung der Menge
Dann kommt der nächste dran
Wäre sowas möglich ?
Dankeschön

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim raFund As Range, strFirst As String If Target.Column = 1 And Target.Row > 1 Then If Target "" Then Cancel = True With Worksheets("Lager") Set raFund = .Columns("D").Find(what:=Target, LookIn:=xlValues, lookat:=xlWhole) If Not raFund Is Nothing Then strFirst = raFund.Address If raFund.Interior.Color vbYellow Then raFund.Interior.Color = vbYellow MsgBox raFund.Offset(, 1) Exit Sub End If Else MsgBox "Die Artikelnummer " & Target & " wurde nicht gefunden." Exit Sub End If Do If raFund.Interior.Color = vbYellow Then Set raFund = .Columns("D").FindNext(raFund) If Not raFund Is Nothing And raFund.Interior.Color vbYellow Then raFund.Interior.Color = vbYellow MsgBox raFund.Offset(, 1) Exit Do End If End If Loop While Not raFund Is Nothing And raFund.Address strFirst If raFund.Address = strFirst Then MsgBox "Alle Artikel " & Target & " sind schon bearbeitet." End If End With End If End If Set raFund = Nothing End Sub

Hallo,
meinst du, dass die doppelt angeklickte Zelle im Blatt "Fertig" dann gelb gefärbt werden soll, sobald alle entsprechenden Artikelnummern im Blatt "Lager" abgearbeitet wurden?

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim raFund As Range, strFirst As String, i As Long, z As Long
If Target.Column = 1 And Target.Row > 1 Then
If Target  "" Then
Cancel = True
With Worksheets("Lager")
Set raFund = .Columns("D").Find(what:=Target, LookIn:=xlValues, lookat:=xlWhole)
If Not raFund Is Nothing Then
strFirst = raFund.Address
If raFund.Interior.Color  vbYellow Then
raFund.Interior.Color = vbYellow
MsgBox raFund.Offset(, 1)
Exit Sub
End If
Else
MsgBox "Die Artikelnummer " & Target & " wurde nicht gefunden."
Exit Sub
End If
Do
If raFund.Interior.Color = vbYellow Then
Set raFund = .Columns("D").FindNext(raFund)
If Not raFund Is Nothing And raFund.Interior.Color  vbYellow Then
raFund.Interior.Color = vbYellow
MsgBox raFund.Offset(, 1)
Exit Do
End If
End If
Loop While Not raFund Is Nothing And raFund.Address  strFirst
For i = 2 To .Cells(.Rows.Count, "D").End(xlUp).Row
If .Cells(i, "D").Interior.Color = vbYellow Then
z = z + 1
End If
Next i
If WorksheetFunction.CountIf(.Columns("D"), Target) = z Then
Target.Interior.Color = vbYellow
End If
If raFund.Address = strFirst Then
MsgBox "Alle Artikel " & Target & " sind schon bearbeitet."
End If
End With
End If
End If
Set raFund = Nothing
End Sub

Gruß Werner

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

markieren Dispo

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread