anscheinend wird einem hier nicht geholfen...Schade...

Dieses Thema anscheinend wird einem hier nicht geholfen...Schade... im Forum "Microsoft Office Suite" wurde erstellt von Bärli2007, 9. Jan. 2007.

Thema: anscheinend wird einem hier nicht geholfen...Schade... Hallo liebe Members und Profis, anbei findet ihr eine Problembeschreibung. Die Schritte 1 und 2 habe ich in einer...

  1. Hallo liebe Members und Profis,

    anbei findet ihr eine Problembeschreibung.

    Die Schritte 1 und 2 habe ich in einer Exceltabelle errechnet , die Summe gebildet und den Restbetrag manuell aufgeteilt.(Problem 1 ist schon mal die Abrundung, die nicht funktionierte). Da die Tabelle aber variabel lang wird und die Verteilung so kompliziert von Statten gehen soll bin ich ratlos.

    Das VBA so etwas kann weiß ich, aber selbst die Boardsuche hat mir leider nicht weitergeholfen.

    Freu mich auf goood News,gerne auch per Mail

    lg

    Chrissi (Crissi2007@qmailx.de)
    ____________________________________
    Das Problem:

    In Zelle A1 steht eine Summe, welche für den Kauf neuer Werkzeuge vorgesehen ist (bspw 50.000 Euro)

    In Cells B1 steht die gesamte Anzahl an verschiedenen Werkzeugen (bspw. 50)

    (Vorbemerkung: Im ersten Schritt soll für die zu kaufenden Werkzeuge jeweils derselbe Betrag für den Kauf zur Verfügung stehen, also 50.000 Euro / 50 Werkzeuge = 1000 EURO)

    In Spalte C, Zeile 1-50 stehen die Werkzeugnamen, in Spalte E, Zeile 1-50 steht der jew. Preis eines Werkzeuges dieser Art.

    Start-Tabelle:

    A----------B----------C--------------D--------------------E
    50.000----50------Bohrhammer_____(gesuchte Anzahl)_____30 Euro/Stück
    ------------------Schleifstein___(gesuchte Anzahl)______5 Euro/Stück
    ------------------Spezialmesser__(gesuchte Anzahl)_____35 Euro/Stück

    Ziel-Tabelle:

    A----------B----------C--------------D-----------------------E
    50.000----50------Bohrhammer________39 Stück______________30 Euro/Stück
    ------------------Schleifstein______25 Stück______________5 Euro/Stück
    ------------------Spezialmesser_____22Stück_______________35 Euro/Stück

    1.)
    Im ersten Schritt werden von jeder der 50 Gattungen mit dem Anfangsbetrag in Höhe 1000 Euro Werkzeuge gekauft und die Anzahl anschliessend automatisch abgerundet [Bildung temporärer Verrechnungsspalte Spalte F]

    Bsp: 1000?/30 = 33,33 gerundet ->> 33
    1000?/5 = 200 ->> 200
    1000?/35 = 28,57 ->> 28

    2.)
    Im nächsten Schritt wir der bisher verbrauchte Betrag(Zwischensumme) ermittelt (Multiplikation Anzahl bisher gekaufter Werkzeuge mit den jeweiligen Stückpreisen) und der verbleibende und zu verbrauchende Restbetrag ermittelt:

    Bsp: 33*30 = 990
    200*5 = 1000
    28*35= 980
    usw...

    Beispiel Restbetrag 50000-48000(errechnete Zwischensumme) = 2000

    3.) Von diesem Restbetrag wird nun beginnend mit Werkzeug 1 jeweils 1 Werkzeug gekauft (1 Bohrhammer zu 30?, 1 Schleifstein zu 5 ? usw.), bis der Restbetrag verbraucht ist.

    Sollte nach dem Kauf eines einzelnen Werkzeugs jeder Gattung nach Werkzeug 50 immer noch Restguthaben vorhanden sein, so soll so lange Zeile für Zeile 1 Werkzeug gekauft werden, bis der Restbetrag verbraucht ist.

    Sollte der letzte Restbetrag bspw. 27? sein und die Berechnung befindet sich in Zeile 1, so kann der Bohrhammer nicht gekauft werden -> automatisch wird zur nächsten Zeile gesprungen (Preis Schleifstein 5 ?) -> Kauf 1 Schleifstein -> verbleibender Restbetrag 22? (Preis Spezialmesser 35 Euro) -> dieses wird übersprungen und das nächste Werkzeug erworben, dessen Preis unter 22 ? liegt.... USW....Operation ist quasi beendet wenn ein Restbetrag verbelibt, der niedriger als das billigste Werkzeug ist (bspw. 2 ?).

    4.)

    In Spalte D wird nun jedem Werkzeug die ermittelte endgültige Stückzahl zugeordnet, in Cell A2 wird der letzte nicht verwendbare Restbetrag in ? angezeigt.

    OPERATION beendet - PaTIENT lebt.
     
  2. mail ist unterwegs :)
     
  3. mail kommt leider zurück  :'(  (unzustellbar  :mad: )
    Jetzt wartet das Makro auf Abholung .
     
  4. Kaufst Du ein h. ;)

    Eddie
     
  5. Jo, da kommt erstmal nix zurück :1
     
  6. Makro für dieses Problem:
    Code:
    Option Explicit
    
    Type myWerkzeug_Struct
      Name           As String
      Anz            As Long
      PreisProStueck As Double
      Preis          As Double
    End Type
    
    Private Const cRANGE_VORGABEBETRAG = A1
    Private Const cRANGE_RESTBETRAG = A2
    Private Const cRANGE_ANZWERKZEUGE = B1
    Private Const cRANGE_WERKZEUGNAME_ANFANG = C1
    Private Const cOFFSET_WERKZEUGANZAHL = 1
    Private Const cOFFSET_WERKZEUGPREIS = 2
    Private Const cOFFSET_WERKZEUGPREISGESAMT = 3
    
    
    Sub BerechnungWerkzeugEinkauf()
      
      Dim dVorgabeBetrag As Double, lAnzWerkzeuge As Long
      Dim dRestBetrag As Double
      Dim WLi() As myWerkzeug_Struct, WLiCnt As Long
      Dim ws As Worksheet
      
      Set ws = ActiveSheet
      
      If Not WerteEinlesen(ws, dVorgabeBetrag, lAnzWerkzeuge, _
                           WLi(), WLiCnt) Then GoTo AUFRAEUMEN
      
      
      Call EinkaufBerechnen(dVorgabeBetrag, lAnzWerkzeuge, WLi(), WLiCnt, dRestBetrag)
      
      Call WerteAusgeben(ws, dRestBetrag, WLi(), WLiCnt)
    
    AUFRAEUMEN:
      Set ws = Nothing
    End Sub
    '*****************************************************************
    Private Function WerteAusgeben(ws As Worksheet, _
                                   dRestBetrag As Double, _
                                  WLi() As myWerkzeug_Struct, WLiCnt As Long)
      Dim x As Long
                               
      ws.Range(cRANGE_RESTBETRAG).Value = dRestBetrag
    
      With ws.Range(cRANGE_WERKZEUGNAME_ANFANG)
        For x = 1 To WLiCnt
          .Offset(x - 1, cOFFSET_WERKZEUGANZAHL).Value = WLi(x).Anz
          .Offset(x - 1, cOFFSET_WERKZEUGPREISGESAMT).Value = WLi(x).Preis
        Next
      End With
    End Function
    
    '*****************************************************************
    Private Function EinkaufBerechnen(dVorgabeBetrag As Double, lAnzWerkzeuge As Long, _
                                      WLi() As myWerkzeug_Struct, WLiCnt As Long, _
                                      dRestBetrag As Double)
    
      Dim dVorgabeProWerkzeug As Double, x As Long, bNixGetan As Boolean
    
     ->VorgabeBetrag pro Werkzeug auf Euro runden
      dVorgabeProWerkzeug = dVorgabeBetrag \ lAnzWerkzeuge
      
     ->Für alle Werkzeuge die Anzahl aus dem VorgabeBetrag pro Werkzeug berechnen
      dRestBetrag = dVorgabeBetrag
      For x = 1 To WLiCnt
        WLi(x).Anz = dVorgabeProWerkzeug \ WLi(x).PreisProStueck
        WLi(x).Preis = WLi(x).Anz * WLi(x).PreisProStueck
        dRestBetrag = dRestBetrag - WLi(x).Preis
      Next
    
     ->die Werkzeuge der Reihenfolge nach prüfen,
     ->ob für den Restbetrag 1 Werkzeug gekauft werden kann.
     ->wenn ja, dann eins kaufen
     ->
     ->Das ganze solange bis der Restbetrag unter dem Preis
     ->des billigsten Werkzeugs liegt
      Do
        bNixGetan = True
        For x = 1 To WLiCnt
          If WLi(x).PreisProStueck <= dRestBetrag Then
            WLi(x).Anz = WLi(x).Anz + 1
            WLi(x).Preis = WLi(x).Preis + WLi(x).PreisProStueck
            dRestBetrag = dRestBetrag - WLi(x).PreisProStueck
            bNixGetan = False
          End If
        Next
        If bNixGetan Then Exit Do
      Loop
    
    End Function
    
    
    
    '*****************************************************************
    Private Function WerteEinlesen(ws As Worksheet, _
                                    dVorgabeBetrag As Double, _
                                    lAnzWerkzeuge As Long, _
                                    WLi() As myWerkzeug_Struct, WLiCnt As Long _
                                    ) As Boolean
    
      Dim sWName As String, dWPreis As Double, z As Long
      
     ->VorgabeBetrag einlesen
      On Error Resume Next
      dVorgabeBetrag = ws.Range(cRANGE_VORGABEBETRAG).Value
      If Err.Number <> 0 Then
        MsgBox _
          Fehler beim Einlesen VorgabeBetrag. & vbLf & _
          Blatt  & ws.Name &  Zelle:  & cRANGE_VORGABEBETRAG & vbLf & _
          Err.Description
        Err.Clear: On Error GoTo 0: GoTo AUFRAEUMEN
      End If
      On Error GoTo 0
      If dVorgabeBetrag < 1# Then
        MsgBox _
          VorgabeBetrag < 1 ? & vbLf & _
          Blatt  & ws.Name &  Zelle:  & cRANGE_VORGABEBETRAG
        GoTo AUFRAEUMEN
      End If
      
     ->Anzahl Werkzeuge einlesen
      On Error Resume Next
      lAnzWerkzeuge = ws.Range(cRANGE_ANZWERKZEUGE).Value
      If Err.Number <> 0 Then
        MsgBox _
          Fehler beim Einlesen Anzahl Werkzeuge. & vbLf & _
          Blatt  & ws.Name &  Zelle:  & cRANGE_ANZWERKZEUGE & vbLf & _
          Err.Description
        Err.Clear: On Error GoTo 0: GoTo AUFRAEUMEN
      End If
      On Error GoTo 0
      If lAnzWerkzeuge < 1 Then
        MsgBox _
          Anzahl Werkzeuge < 1 & vbLf & _
          Blatt  & ws.Name &  Zelle:  & cRANGE_ANZWERKZEUGE
        GoTo AUFRAEUMEN
      End If
      
     ->Werkzeugliste einlesen
      WLiCnt = 0: ReDim WLi(1 To lAnzWerkzeuge)
      For z = 1 To lAnzWerkzeuge
        sWName = ws.Range(cRANGE_WERKZEUGNAME_ANFANG).Offset(z - 1, 0).Value
        On Error Resume Next
        dWPreis = ws.Range(cRANGE_WERKZEUGNAME_ANFANG). _
                           Offset(z - 1, cOFFSET_WERKZEUGPREIS).Value
        If Err.Number <> 0 Then
          MsgBox _
            Fehler beim Einlesen Werkzeuge-Preis. & vbLf & _
            Blatt  & ws.Name &  Zelle:  & _
                ws.Range(cRANGE_WERKZEUGNAME_ANFANG). _
                Offset(z - 1, cOFFSET_WERKZEUGPREIS).Address(False, False) & vbLf & _
            Err.Description
          Err.Clear: On Error GoTo 0: GoTo AUFRAEUMEN
        End If
        On Error GoTo 0
        If dWPreis <= 0# Then
          MsgBox _
            Werkzeugpreis <= 0 ? & vbLf & _
            Blatt  & ws.Name &  Zelle:  & _
                ws.Range(cRANGE_WERKZEUGNAME_ANFANG). _
                Offset(z - 1, cOFFSET_WERKZEUGPREIS).Address(False, False)
          GoTo AUFRAEUMEN
        End If
        
       ->Wert ok -> in Liste eintragen
        WLiCnt = WLiCnt + 1
        WLi(WLiCnt).Name = sWName
        WLi(WLiCnt).PreisProStueck = dWPreis
      Next
    
      WerteEinlesen = True
    AUFRAEUMEN:
    
    End Function
    Gruß Matjes :)
     
  7. Ola,

    nur so mal meine Meinung: Zwischen Hilfe erwarten und der Erwartung, mal eben etwas programmiert zu bekommen, besteht meines Erachtens ein großer Unterschied. Und das dann auch sofort? Also Wirklich ....
     
Die Seite wird geladen...

anscheinend wird einem hier nicht geholfen...Schade... - Ähnliche Themen

Forum Datum
PC anscheinend defekt. Hardware 19. Juli 2009
soundtreiber fehlen anscheinend, windows zeigt keine fehler im gerätemanager an! Windows XP Forum 15. Dez. 2006
anscheinend einige inzifierungen, brauche hilfe Viren, Trojaner, Spyware etc. 17. Juni 2006
IE löscht die history anscheinend nicht richtig Windows XP Forum 8. Juni 2004
trotz komplett neuem setup wird pc immer langsamer Windows 10 Forum Gestern um 12:22 Uhr