Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema CommandButton
BildScreenshot zu CommandButton CommandButton-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen

FIFO mit VBA (Endlosschleife?)

Betrifft: FIFO mit VBA (Endlosschleife?) von: Bernhard
Geschrieben am: 21.08.2008 21:06:36

Hallo liebe Experten,

da ich in VBA noch ziemlich unbeleckt bin, habe ich zur Lösung einer FIFO Aufgabenstellung u.a. VBA Lösung ergoogelt, die eigentlich funktioniert, lediglich der 2. Teil Starting_Inventory läuft scheinbar in eine Endlosschleife. Was ist falsch? Habe auch ein Beispieldatei hochgeladen.
https://www.herber.de/bbs/user/54795.xls

Sub Update_Inventory()
Starting_Inventory
Dim endrow As Long 'last row in range
Dim Title As String 'book title
Dim Mycell As Range 'Cell with sold book title
'Dim MyCell2 As Range
Dim qtySell As Long 'Sell volume in current row
Dim i As Long 'row counter
Dim buysell As Range
Dim MyRow As Long
Dim RemInv As String
Dim invred As Long
Dim Lastrow As Long 'row above sell transaction
endrow = Range("A" & Rows.Count).End(xlUp).Row
Set buysell = Range("B1:B" & endrow).Find("Sell", LookIn:=xlValues)
If buysell Is Nothing Then
Exit Sub
End If
For i = Range(buysell.Address).Row To endrow Step 1
Title = Range(buysell.Address).Offset(0, -1).Value
qtySell = buysell.Offset(0, 2).Value
Lastrow = buysell.Row - 1
For Each Mycell In Range("A1:A" & Lastrow)
Do While MyRow < buysell.Row
If Mycell.Value <> Title Then
GoTo nextmycell:
ElseIf Mycell.Offset(0, 1).Value = "buy" Then
RemInv = Range(Mycell.Address).Offset(0, 6).Address
If Range(RemInv).Value = 0 Then
GoTo nextmycell:
ElseIf qtySell <= Range(RemInv).Value Then
Range(RemInv).Value = Range(RemInv).Value - qtySell
qtySell = 0
MyRow = buysell.Row
GoTo NextSale:
ElseIf Range(RemInv).Value < qtySell Then
invred = Range(RemInv).Value
Range(RemInv).Value = 0
qtySell = qtySell - invred
GoTo nextmycell:
End If
End If
Loop
nextmycell:
Next Mycell

NextSale:
On Error GoTo ErrorHandler:
Set buysell = Range("B" & i & ":B" & endrow). _
FindNext(buysell)
Next
ErrorHandler:
End Sub



Sub Starting_Inventory()
Dim endrow As Long
Dim Mycell As Range
endrow = Range("A" & Rows.Count).End(xlUp).Row
For Each Mycell In Range("A1:A" & endrow)
If Mycell.Offset(0, 1).Value = "buy" Then
Mycell.Offset(0, 6).Value = Mycell.Offset(0, 3).Value
End If
Next Mycell
End Sub



Für eure Hilfe bin ich sehr dankbar.

Viele Grüsse

Bernhard

  

Betrifft: AW: FIFO mit VBA (Endlosschleife?) von: Horst
Geschrieben am: 21.08.2008 21:33:45

Hi,

hast du das selbst mal mit deinen hochgeladenen testdaten probiert?

Klappt einwandfrei, vielleicht ist in der Originaldatei was anders oder tausdende datensätze, dass
das lange dauert?

mfg Horst


  

Betrifft: AW: FIFO mit VBA (Endlosschleife?) von: Bernhard
Geschrieben am: 21.08.2008 21:58:01

Hallo Horst,

Danke für Deine Antwort. Bei mir gibt es ein Problem mit dem Code. Selbst mit nur wenig mehr Daten wie in meiner Beispielsdatei hängt die Sanduhr ewig! Habe keine Ahnung warum? Liegt es eventuell daran, dass im 2. Sub kein ErrorHandler eingebaut ist?

Kannst Du nochmals einen Blick drauf werfen?

Gruss

Bernhard


  

Betrifft: AW: FIFO mit VBA (Endlosschleife?) von: Uduuh
Geschrieben am: 21.08.2008 23:38:34

Hallo,
ad sitz tschon mal ne Klammer falsch:
endrow = Range("A" & Rows.Count).End(xlUp).Row
muss sein:
endrow = Range("A" & Rows.Count.End(xlUp).Row)
besser noch
endrow = cells(Rows.Count, 1).End(xlUp).Row

Gruß aus’m Pott
Udo



  

Betrifft: AW: FIFO mit VBA (Endlosschleife?) von: Bernhard
Geschrieben am: 22.08.2008 09:38:09

Hallo Udo,
Danke für Deinen Hinweis. Habe den Code entsprechend geändert. Dennoch habe ich selbst mit der kurzen Beispieldatei das Problem, dass Excel "einfriert", wenn ich den 2. Teil des Codes ausführe. Er schreibt mir zwar das richtige Ergebnis in die Spalte, lässt aber ein weiterarbeiten nicht zu!?

Was ist da falsch?

Für jede Hilfe dankbar grüsse ich aus der Schweiz

Bernhard


  

Betrifft: AW: FIFO mit VBA (Endlosschleife?) von: mpb
Geschrieben am: 22.08.2008 10:39:00

Hallo Udo,

"muss sein:
endrow = Range("A" & Rows.Count.End(xlUp).Row)"

Das liefert eine Fehlermeldung. Bernhard sucht doch die letzte letzte besetzte Zelle in Spalte A, da ist der ursprünglich Code doch in Ordnung. Oder verstehe ich Dich falsch?

Gruß
Martin


  

Betrifft: AW: FIFO mit VBA (Endlosschleife?) von: Bernhard
Geschrieben am: 22.08.2008 12:06:52

Hallo Martin,
habe auch Deinen Code probiert. Das Problem bleibt. Excel friert ein. Was ist an diesem Code nur falsch?
Könnt Ihr mir bitte weiterhelfen?

Gruss
Bernhard


  

Betrifft: AW: FIFO mit VBA (Endlosschleife?) von: mpb
Geschrieben am: 22.08.2008 12:56:57

Hallo Bernhard,

kannst Du Originaldatei mal hochladen? Der Code ist m.E. in Ordnung und läuft mit der Beispieldatei auch einwandfrei.

Gruß
Martin


  

Betrifft: AW: FIFO mit VBA (Endlosschleife?) von: Bernhard
Geschrieben am: 22.08.2008 13:41:09

Hi Martin,



hier nochmals die Originaldatei.

https://www.herber.de/bbs/user/54818.xls


Den Originalcode habe ich von u.a. Site.

http://www.wiredbox.net/Forum/Thread286577_How_to_program_FIFO_inventory_in_excel_.aspx




Habe gerade nochmal bei mir ausprobiert, aber wieder Excel (keine Rückmeldung) und die Berechnung für die Artikel ab DEF stimmt nicht bzw. wurde nicht durchgeführt.



Danke für Deine Zeit und Mühe



Gruss

Bernhard


  

Betrifft: AW: FIFO mit VBA (Endlosschleife?) von: Heiko S.
Geschrieben am: 22.08.2008 14:37:22

Hallo Bernhard,

eins kann ich dir mit Sicherheit sagen, der Code für Starting_Inventory läuft einwandfrei durch.
Wenn man den Code alleine laufen läßt.

Der Code für Update_Inventory ruft in der ersten Zeile das laufende Programm Starting_Inventory auf, auch läuft der Code für Starting_Inventory durch. Hängen tut das Programm im Update_Inventory in der Schleife For I = ...

Da ich diesen Code aber nicht nachvollziehen kann, will (weil mehrere Goto Befehle drin sind) beschreibe uns doch mal was dieser Code eigentlich bewirken soll, ich glaube dann kann dir besser helfen indem man den Teil neu schreibt.


Gruß Heiko


  

Betrifft: AW: FIFO mit VBA (Endlosschleife?) von: mpb
Geschrieben am: 22.08.2008 15:06:32

Hallo Heiko,

dem kann ich mich nur anschließen. Der Code ist nur sehr schwer zu durchschauen.

Das eigentliche Problem habe ich so verstanden:

Es gibt Käufe und Verkäufe eines Produktes. Folgende Informationen liegen vor: Name des Produkts (Spalte A), Art der Transaktion (B), Preis (C), Menge (D) und Einkaufsdatum (E). Starting_Inventory überträgt die gekauften Mengen in Spalte G. Jetzt kommt FIFO (first in first out) zum tragen. Das heißt, das Makro Update_Inventory zieht von der zuerst eingekauften Menge sukzessive die Verkäufe ab und trägt die verbleibende Menge in die Zeile des Einkaufs in Spalte G ein. Wurde der gesamte Ersteinkauf verkauft, werden weitere verkaufte Mengen des gleichen Produkts vom zweiten Einkauf abgezogen usw. Übrig bleiben die noch vorhandenen Bestände des Produkts, und zwar zugeordnet den Zeilen des "ältesten möglichen Einkaufs". Sie können dann mit dem entsprechenden Preis bewertet werden, so dass insgesamt eine Bewertung des Lagerbestandes nach dem FIFO-Prinzip erfolgt.

Um das jetzt zu programmieren, fehlt mir momentan die Zeit. Bei der Fehleranalyse bin auch nicht sehr weit gekommen. In jedem Fall hängt das Makro in Zeile 8 der Tabelle.

Gruß
Martin


  

Betrifft: AW: FIFO mit VBA (Endlosschleife?) von: Bernhard
Geschrieben am: 22.08.2008 15:27:23

Hallo Martin,
gerade sehe ich Deine Antwort. Sie hat sich mit meiner neuen Erklärung überschnitten. Du hast die Problematik richtig erklärt. Ich verstehe, dass Du keine Zeit hast, Dich noch tiefer reinzuvertiefen. Trotzdem nochmals Danke.
Ich hoffe, jemand hat eine bestehende Lösung.

Gruss

Bernhard


  

Betrifft: AW: FIFO mit VBA (Endlosschleife?) von: Bernhard
Geschrieben am: 22.08.2008 15:19:41

Hallo Heiko,

Danke, dass auch Du dir Zeit nimmst für mein Problem.
In einer Liste werden die Ein- bzw. Verkäufe von vielen verschiedenen Artikeln/Produkten in chronologischer Reihenfolge erfasst.
Mit dem betreffenden Code will ich aus dieser Liste die Bestände der unterschiedlicher Artikel nach dem FIFO-Prinzip gewinnen. Die Orginalliste wird sehr viele Zeilen haben und deshalb suche ich eine VBA Lösung. Die gesuchte Lösung soll die ältesten Bestände des jeweiligen Artikels mit der Anzahl der Verkäufe zuerst abarbeiten, bis ein Bestand übrig bleibt. Überverkäufe sind nicht zugelassen, d.h. kein negativen Bestände.
Ich hoffe, ich habe die Aufgabe ausreichend erklärt, wenn nicht, bitte nochmals nachfragen.

Für Deine Hilfe wäre ich sehr dankbar.

Mit freundlichen Grüssen

Bernhard


  

Betrifft: AW: FIFO mit VBA (Endlosschleife?) von: Heiko S.
Geschrieben am: 22.08.2008 18:31:56

Hallo Bernhard,

also so ganz habe ich das noch nicht verstanden. Aber wenn du mir das nochmal genauer erklären kannst, am besten mit einer Beispieldatei wie das denn am Ende ausssehen soll, läßt sich da bestimmt was machen.

Spätestens am Montag käme ich wieder dazu.

Also muss du zur Not nur ein bisschen warten.

Gruß Heiko


  

Betrifft: AW: FIFO mit VBA (Endlosschleife?) von: Heiko S.
Geschrieben am: 22.08.2008 19:42:49

Hallo Bernhard,

so hier mal ein Versuch von mir, bitte reinschauen (Makro startet über den Button) und dann Kommentare und Beispiele beifügen (in Spalte H) wenn es nicht ganz das ist was du willst.

https://www.herber.de/bbs/user/54826.xls

So nu bist du gefragt,


Gruß Heiko


  

Betrifft: AW: FIFO mit VBA (Endlosschleife?) von: Bernhard
Geschrieben am: 22.08.2008 21:33:06

Hallo Heiko,
das ist nett, dass Du Dich nochmals mit dem Problem beschäftigt hast. Ich habe mir Deine Lösung angesehen und sie bringt das richtige Ergebnis für alle Artikel, ausgenommen "DEF". Wie Du richtig bemerkst, müsste die Kaufposition mit 30 dann 0 sein und die Kaufposition 55 = 10, wobei die erste Kaufposition auch = 0, nicht 5 sein muss. Ich erkenne, dass die Lösung nicht so trivial ist.!!!

https://www.herber.de/bbs/user/54830.xls

Da meine Vba-Kenntnisse noch sehr rudimentär sind, komme ich selbst nicht weiter. Ich würde mich freuen, wenn Du - oder auch andere Excel-Experten - sich/Dich an die Lösung machst/en.
Für heute mache ich Schluss mit der "Excelei", morgen ist auch wieder ein Tag!

Also Heiko, ich wünsch ein schönes Wochenende.

Grüsse aus der Schweiz

Bernhard


  

Betrifft: AW: FIFO mit VBA (Endlosschleife?) von: Erich G.
Geschrieben am: 22.08.2008 23:38:34

Hallo Bernhard,
ich bin mal nur von den Daten in der Mappe 54830.xls ausgegangen und hab versucht,
das mit einer neuen Prozedur unabhängig von den bisherigen zu lösen:

Option Explicit

Private Sub CommandButton1_Click()
   Dim lngL As Long, zz As Long, strNa As String, dblV As Double

   lngL = Cells(Rows.Count, 1).End(xlUp).Row
   For zz = 2 To lngL
      strNa = Cells(zz, 1)
      dblV = Evaluate("=SUMPRODUCT(D2:D" & lngL & "*(A2:A" & lngL & "=A" & zz _
         & ")*(B2:B" & lngL & "= ""sell""))")
      While Cells(zz, 1) = strNa
         If Cells(zz, 2) = "buy" Then
            Cells(zz, 8) = Application.Max(, Cells(zz, 4) - dblV)
            dblV = Application.Max(, dblV - Cells(zz, 4))
         End If
         zz = zz + 1
      Wend
      zz = zz - 1
   Next zz
End Sub

Und hier die Mappe dazu: https://www.herber.de/bbs/user/54833.xls
Schaust du mal, ob das nun gelungen ist?

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


  

Betrifft: AW: FIFO ohne VBA oder mit VBA ohne Schleife von: Erich G.
Geschrieben am: 23.08.2008 06:49:30

Hi Bernhard,
bei etwas konsequenterer Nutzung der Exelfkt. SUMMENPRODUKT gehts mit VBA
auch ganz ohne Schleife:

Option Explicit

Sub FIFO_Formel()
Dim zz As Long
zz = Cells(Rows.Count, 1).End(xlUp).Row
With Range("H2").Resize(zz - 1)
   .Formula = _
     "=IF(B2=""buy"",MAX(,SUMPRODUCT(D$2:D2*(A$2:A2=A2)*(B$2:B2=""buy""))" _
     & "-SUMPRODUCT($D$2:$D$" & zz & "*($A$2:$A$" & zz & "=A2)" _
     & "*($B$2:$B$" & zz & "=""sell""))),"""")"
'   .Value = .Value
End With
End Sub

.Value = .Value ist auskommentiert, damit man die Formel in der Tab. noch sehen kann.

Ganz ohne VBA kann man natürlich die Formel auch einfach per Hand in die Tab. schreiben.

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


  

Betrifft: AW: ist wohl noch zu früh... von: Erich G.
Geschrieben am: 23.08.2008 08:20:01

Hi,
sorry, die Formel in meinem letzten Beitrag liefert leider Blödsinn.

Ich versuchs noch einmal, sobald ich die Zeit dafür finde.

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


  

Betrifft: AW: ist wohl noch zu früh... von: Bernhard
Geschrieben am: 23.08.2008 09:14:19

Hallo Erich,

habe gerade Deine erste Lösung getestet und sie funktioniert!!!! Werde das später mal an einer längeren Liste austesten.

Danke zunächst einmal für Deine Mühe.

Bis später

Bernhard


  

Betrifft: AW: ist wohl noch zu früh... von: Bernhard
Geschrieben am: 23.08.2008 15:20:37

Hallo Erich,

habe Deine Lösung jetzt ausführlich getestet und sie funktioniert perfekt.

Danke Dir vielmals, auch all den anderen, die sich mit meinem Problem beschäftigt haben!

Ich wünsche ein schönes Wochende.

Gruss aus der Schweiz

Bernhard


  

Betrifft: AW: Hoffentlich spät genug: Formellösung von: Erich G.
Geschrieben am: 24.08.2008 00:19:15

Hi Bernhard,
jetzt hat es hoffentlich doch noch geklappt mit einer Formellösung.

In Spalte G stehen die Formeln, per Hand eingetragen.
G2 muss etwas kürzer sein, ab G3 nach unten sind die Formeln gleich (kopierbar).

Spalte H kennst du schon, Spalte I wird mit dem zweiten Button gefüllt - die Prozedur
schreibt Formeln (à la Spalte G) in Spalte I und ersetzt sie dann durch die Werte.

Da die Formeln überall Nullen statt Leerzellen brauchen, habe ich das Zahlformat in den
Spalten G bis I auf 0;0; gestellt - dann wird die 0 nicht angezeigt.

Hier die Formeln:

 GHIJ
1ohne VBAVBAVBA-Formel 
250505050
3100100100100
4    
510101010
6    
7100100100100
8   0
9    
10   0
1110101010
12    

Formeln der Tabelle
ZelleFormel
G2=WENN($B2="buy";MAX(;SUMMENPRODUKT($D$2:$D2*($A$2:$A2=$A2)*($B$2:$B2="buy")) -SUMMENPRODUKT($D$2:$D$999*($A$2:$A$999=$A2)*($B$2:$B$999="sell"))); "Fehler")
G3=WENN($B3="buy";MAX(;SUMMENPRODUKT($D$2:$D3*($A$2:$A3=$A3)*($B$2:$B3="buy")) -SUMMENPRODUKT($D$2:$D$999*($A$2:$A$999=$A3)*($B$2:$B$999="sell")) -SUMMENPRODUKT(G$2:G2*($A$2:$A2=$A3))); 0)
G4=WENN($B4="buy";MAX(;SUMMENPRODUKT($D$2:$D4*($A$2:$A4=$A4)*($B$2:$B4="buy")) -SUMMENPRODUKT($D$2:$D$999*($A$2:$A$999=$A4)*($B$2:$B$999="sell")) -SUMMENPRODUKT(G$2:G3*($A$2:$A3=$A4))); 0)

und hier die Mappe: https://www.herber.de/bbs/user/54855.xls

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


  

Betrifft: AW: Hoffentlich spät genug: Formellösung von: Bernhard
Geschrieben am: 24.08.2008 07:42:35

Hallo Erich,

super! Alle 3 Deiner Lösungen funktionieren einwandfrei!!! - und stellen mich nun vor ein unlösbares Problem:
welche nehmen?????????;-)
Also Erich, Du hast mir sehr, sehr geholfen.
Jetzt sitze ich an einer Userform, mit der die Ausgangsliste gefüllt werden soll. Ein Herausforderung für einen Frischling in VBA. Da werde ich sicher wieder die Hilfe des besten Excel-Forums brauchen.
Einen schönen Sonntag aus der Schweiz wünscht

Bernhard


  

Betrifft: Danke für Rückmeldung, auch schönen Sonntag! (owT) von: Erich G.
Geschrieben am: 24.08.2008 08:17:07