PDA

Vollständige Version anzeigen : Warenliste


derhard
01.09.2017, 15:06
Hallo zusammen!
Suche eine effiziente VBA Lösung um aus einer dynamischen Warenbestandsliste schnell die Waren zu finden und auszuwählen
und auf die Tabelle Einkaufszettel zu übertragen die ich für meinen Einkauf benötige!
Desweiteren sollten auf dem Einkaufszettel neben der ausgewählten Ware auch die dafür aktuellen Preise der Märkte übertragen werden um einen Vergleich zu erhalten sowie das aktuelle Datum.
Die Tabelle Einkaufszettel sollte bearbeitbar sein um einzelne Waren aus der dieser Tabelle auch wieder entfernen zu können.
In die Tabelle Archiv sollten dann die Einkaufszettel nebeneinander gesammelt und abgelegt werden können.
Für Lösungsvorschläge wäre ich Euch sehr dankbar!

Vielen Dank für Eure Hilfe
Gruß Derhard

Jonas0806
01.09.2017, 16:46
Hallo Derhard,

mal als Ansatz

Für Tabelle1:
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim arr
If Not Intersect(Target, UsedRange) Is Nothing Then
Cancel = True
With Tabelle2
arr = Cells(Target.Row, 1).Resize(1, 4)
.Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Resize(1, 4) = arr
End With
End If
End Sub


Eine Schaltfläche zum archivieren auf Tabelle2:
Private Sub CommandButton1_Click()
Dim arr

arr = Me.Cells(2, 1).Resize(Me.Cells(Rows.Count, 1).End(xlUp).Row - 1, 4)
Me.UsedRange.Offset(1, 0).ClearContents
With Tabelle3
.Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 3, 1).Resize(UBound(arr), 4) = arr
End With
End Sub

derhard
01.09.2017, 17:58
Hallo Jonas,
Vielen Dank zuerst einmal für Deine Hilfe.
Folgende Punkte sind mir aufgefallen:
1.) Bei Auswahl mit Doppelklick werden nicht Preise aus Markt-03 übertragen
2.) Es sollte auch ein Datum übertragen werden
3.) Es sollte auch möglich sein eine Stückzahl einzutragen
4.) Bei Auswahl einer Ware mit Doppelklick wäre gut, wenn z.B ein Häckchen
als Rückmeldung angezeigt werden würde
nach einem erneuten Doppelklick auf eine bereits ausgewählte Ware sollte
die Ware aus der Tabelle Einkaufsliste wieder entfernt werden können.
5.) Beim Archivieren sollten die Einkaufslisten mit Datum nicht untereinander sondern nebeneinander vielleicht mit einer Leerspalte Abstand übertragen werden
6. Ist es möglich bei einer sehr langen Warenliste nach einer Ware gezielt zu suchen z.B mit einer Filterroutine

Vielen Dank
Gruß Derhard

Jonas0806
01.09.2017, 22:05
Hallo,

komplett ohne Fehlerbehandlung und wieder nur als Anstoß. Ein bisschen was darfst Du auch selbst machen ;)

Tabelle1:
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim arr
Dim rng As Range

If Not Intersect(Target, UsedRange) Is Nothing Then
Cancel = True
Set rng = Cells(Target.Row, 1).Resize(1, 5)
With Tabelle2
If rng.Interior.Color <> vbYellow Then
arr = rng
rng.Interior.Color = vbYellow
With .Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
.Resize(1, 5) = arr
.Offset(0, 6).Value = InputBox("Anzahl:")
.Offset(0, 7).Value = Date
End With
Else
.Rows(WorksheetFunction.Match(rng(1), .Range("A:A"), 0)).Delete
rng.Interior.Color = xlColorIndexNone
End If
End With
End If
End Sub


Tabelle2 Button:
Option Explicit

Private Sub CommandButton1_Click()
Dim arr

arr = Me.Cells(2, 1).Resize(Me.Cells(Rows.Count, 1).End(xlUp).Row - 1, 7)
Me.UsedRange.Offset(1, 0).ClearContents
Tabelle1.UsedRange.Interior.Color = xlColorIndexNone
With Tabelle3
.Cells(1, .Cells(1, Columns.Count).End(xlToLeft).Column + 2).Resize(UBound(arr), 7) = arr
End With
End Sub