Bestände vergleichen und ausgeben
01.12.2006 09:27:14
MarkusR
ich hab mal wieder ein kleines Problem und zwar:
Ich habe eine Liste mit Daten und Beständen. Jetzt möchte ich eine Abfrage mit einem Button einbauen, der die IST Bestände mit den Soll Beständen vergleicht und bei einer Unterdeckung alle Artikel in einem neuen Tabellenblatt ausgibt.
Ich habe was ähnliches schon mal gemacht mit Kundendaten. Da musste ich aber nur die Nummer ausgeben, die ich in der Auswahl eingegeben habe. Jetzt hänge ich irgendwie.
So sieht meine Bisherige Programmierung aus. Vielleicht kann man die ja einfach anpassen:
Sub Kundendaten()
Dim Verkaeufer(), wks1 As Worksheet, wks2 As Worksheet
Dim Finden As Range, Suchbereich As Range, KundenNr As String
'Anzahl Verkäufer
Anzahl = 6
'Tabellennamen der Verkäufer
ReDim Verkaeufer(1 To Anzahl)
Verkaeufer(1) = "VK1"
Verkaeufer(2) = "VK2"
Verkaeufer(3) = "VK3"
Verkaeufer(4) = "VK4"
Verkaeufer(5) = "VK5"
Verkaeufer(6) = "VK6"
'gesuchte Kundennummer einlesen
KundenNr = ActiveWorkbook.Sheets("Angebote").Range("E5")
Zeile1 = 8 '1. Zeile mit Daten in Verkäufertabellen
SpKNr = 5 ' Nummer der Spalte mit KundenNr in Verkäufertabellen
'Neues Tabellenblatt für gefundene Daten anlegen
Set wks2 = ActiveWorkbook.Sheets.Add
wks2.Name = KundenNr
ZeileNeu = 1 'Zeilenzähler in neuer Tabelle
'Spaltentitel übertragen
ActiveWorkbook.Sheets(Verkaeufer(1)).Rows(6).Copy wks2.Cells(ZeileNeu, 1)
ZeileNeu = ZeileNeu + 1
'KundenNr in den Verkäufertabellen suchen und Zeilen übertragen
For I = 1 To Anzahl
Set wks1 = ActiveWorkbook.Sheets(Verkaeufer(I))
With wks1
Set Suchbereich = .Range(.Cells(Zeile1, SpKNr), .Cells(.UsedRange.Row + .UsedRange.Rows.Count - 1, SpKNr))
End With
With Suchbereich
Set Finden = .Find(What:=KundenNr, LookIn:=xlValues, Lookat:=xlWhole)
If Not Finden Is Nothing Then
ErsteZelle = Finden.Address
Do
Finden.EntireRow.Copy wks2.Cells(ZeileNeu, 1)
ZeileNeu = ZeileNeu + 1
Set Finden = .FindNext(Finden)
Loop While Not Finden Is Nothing And Finden.Address <> ErsteZelle
End If
End With
Next I
End Sub