Supportnet Computer Supportnet Games Supportnet Kochen Explipedia
Login: guestBesucher online: 118
Supportnet Computerforum
SUPPORT
Home
Forum
Tipps & Infos
Blitz Angebote
Members
Hilfe
Video

TOP THEMEN
SSD Test
Alles über SSDs

Android Tipps
iPad Tipps
Google Tipps
Windows 8 FAQ
Windows 7 FAQ
E-Mail FAQ
Netzwerk FAQ
Festplatten FAQ
Datenrettung FAQ
Bildbearbeitung FAQ

Top iPhone Apps
Computer Einsteiger
Die 5 besten...
Explipedia
Themen
Direktlinks

Neue Einträge
News einsenden News einschicken
Tipps einsenden Tipp einschicken

SN-LINKS

Suche
Befreundete Seiten
Top Seiten

Supportnet/Forum/Tabellenkalkulation



Supportnet/Forum/Tabellenkalkulation
von gianna vom 18.05.2017, 09:54 Diese Seite den Supportnet Favoriten hinzufügen  Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden


Zahlenteilung bei mehrern Ausgangs- und Teilzahlen

 (211 Hits)

Hallo zusammen,

es wurde ja bereits diskutiert wie man eine bestimmte Ausgangszahl in unterschiedlich große Teile zerlegt, in Abhängigkeit einer Teilanzahl.

Folgendes Makro teilt bspw. 10 Paletten auf 2 Gebinde-IDs auf:

Sub Zahlenteilung()
Randomize Timer

Dim Ausgangszahl As Integer
Dim Teilanzahl As Integer

Dim Zahl As Integer
Dim Sum As Integer
Dim Max As Integer
Dim z As Integer

Ausgangszahl = Cells(2, 2).Value
Teilanzahl = Cells(2, 3).Value
Sum = 0
Zahl = 0
Max = Ausgangszahl

For z = 1 To Teilanzahl - 1
Zahl = Int(Rnd * ((Max / (Teilanzahl - z)) + 1))
Sum = Sum + Zahl
Cells(1 + z, 1).Value = Zahl
If Sum = Ausgangszahl Then
Max = 0
Else
Max = Ausgangszahl - Sum
End If
Next z
If Sum = Ausgangszahl Then
Cells(1 + Teilanzahl, 1).Value = 0
Else
Cells(1 + Teilanzahl, 1).Value = Ausgangszahl - Sum
End If

End Sub

In Excel sieht das dann wie folgt aus:

Aufteilung Anzahl Paletten Anzahl GebindeID Kennung
4 10 2 1
6 10 2 1
25 3 2
25 3 2
25 3 2
80 2 3
80 2 3

Wie man an meiner Tabelle erkennen kann folgt nach der Aufteilung der 10 Palletten auf 2 Gebinde-IDs direkt die nächste Aufteilung.

Vielleicht kann mich jemand helfen und hat eine Idee wie ich das Makro anpassen kann, dass immer bei "wechselnder Kennung" das Makro erneut Ausgangszahl und Teilanzahl abfragt und ausgibt.

Vielen Dank im Voraus.
Grüße
Gianna


Antwort schreiben 50 Bonuspunkte

Antworten...
Antwort 1 von M.O. vom 18.05.2017, 11:04 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hallo Gianna,

wenn ich das richtig sehe, steht in Zelle B2 die Anzahl der zu teilenden Paletten und in Zelle C2 die Anzahl der gewünschten Gebinde. Aber wo steht denn die Kennung?

Im Moment werden nur die beiden oben genannten Zellen abgefragt. Stehen in deiner Tabelle eventuell mehrere gewünschte Aufteilungen untereinander?

Erkläre doch mal den Aufbau deiner Ausgangstabelle oder stelle eine Beispieltabelle auf einem Hoster deiner Wahl (z.B. hier ein) und poste den Link.

Gruß

M.O.


Antwort noch nicht bewertet Als gute Antwort bewerten
Antwort 2 von gianna vom 18.05.2017, 11:31 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hallo M.O.

ich habe eine Beispieltabelle mal hochgeladen...da sieht man hoffentlich besser was ich meine.

http://www79.zippyshare.com/v/3BteXiFP/file.html

Das Makro trägt mir eine Aufteilung für die Kennung 1 ein und hört dann auf, da die Aufgabe 10 Paletten auf 2 Gebinde IDs zu verteilen gelöst ist.

Und ja damit hats du recht: Es stehen mehrere gewünschte Aufteilungen untereinander. Die nächste Aufteilung wäre dann 25 Paletten auf 3 Gebinde -IDs und danach 80 Paletten auf 2 Gebinde-IDs....usw. Meine Original-Tabelle umfasst über 1600 Kennungen die es aufzuteilen gilt.

Ist das Problem jetzt besser erklärt?

Vielen Dank schonmal.

Grüße
Gianna


Antwort noch nicht bewertet
Antwort 3 von gianna vom 18.05.2017, 11:35 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Achso...vielleicht ist folgende Info noch relevant:

Die Anzahl Paletten bzw. Anzahl Gebinde-ID sind jeweils nur pro Kennung einmal relevant.

Die Abfrage müsste dann quasi immer schauen wann eine neue Kennung anfängt und dann die Ausgangszahl und Teilanzahl erneut abfragen und die Aufteilung auslesen.

Vielen lieben Dank für die Hilfe.
Grüße
Gianna


Antwort noch nicht bewertet
Antwort 4 von M.O. vom 18.05.2017, 14:46 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hallo Gianna,

das folgende Makro gehört in ein Standard Modul deiner Arbeitsmappe:

Sub aufteilen()

Dim lngLetzte As Long
Dim lngZeile As Long
Dim lngAnzPaletten As Long
Dim lngAnzGebinde As Long
Dim lngZahl1 As Long
Dim lngZahl2 As Long
Dim lngID As Variant
Dim i As Long

'letzte Zeile in Spalte ermitteln
lngLetzte = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row

'alle Zeilen durchlaufen
For lngZeile = 2 To lngLetzte
 'Prüfen, ob ID identisch ist mit eingelesener ID
 If lngID <> Cells(lngZeile, 4) Then
   'falls nein, Daten einlesen
   lngID = Cells(lngZeile, 4)     'ID
   lngAnzPaletten = Cells(lngZeile, 2) 'Anzahl Paletten
   lngAnzGebinde = Cells(lngZeile, 3)  'Anzahl Gebinde
   'und Aufteilung errechnen
   lngZahl1 = Int(lngAnzPaletten / lngAnzGebinde) 'Ganze Zahl ermitteln
   If lngAnzPaletten Mod lngAnzGebinde > 0 Then   'prüfen ob Rest vorhanden
        'falls ja, dann Zahl für letztes Gebinde ermitteln
        lngZahl2 = lngAnzPaletten - lngZahl1 * (lngAnzGebinde - 1)
     Else
       'falls nein, dann Zahl1 übernehmen
       lngZahl2 = lngZahl1
   End If
   'Daten in Zeilen schreiben
   For i = 0 To lngAnzGebinde - 2
    Cells(lngZeile + i, 1) = lngZahl1
   Next i
    Cells(lngZeile + lngAnzGebinde - 1, 1) = lngZahl2
 End If
Next lngZeile

End Sub


Probier mal, ob das Makro so arbeitet, wie du willst.

Gruß

M.O.


Antwort noch nicht bewertet Als gute Antwort bewerten
Antwort 5 von gianna vom 18.05.2017, 16:47 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hallo M.O.,

wow vielen herzlichen Dank für deine Unterstützung. Ich habe das Makro in ein Standard-Modul gepackt und es laufen lassen.

Einzig die Tatsache, dass es jetzt anfangs 1,1,1,1,1... oder sogar 0,0,0,... .vergibt und bei der letzten Kennung den REST aufschlägt, macht es genau das was es soll.

http://www75.zippyshare.com/v/oBiS6ngO/file.html

Ich weiß nicht, ob die Möglichkeit besteht die Verteilung etwas "mehr zu streuen"?

Aber schonmal vielen Dank!

Ich versuche jetzt erstmal den Code nachzuvollziehen...

LIebe Grüße
Gianna


Antwort noch nicht bewertet
Antwort 6 von M.O. vom 19.05.2017, 08:22 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hallo Gianna,

ich schaue mir das noch einmal an (ich habe da schon eine Idee). In einigen Zeilen deiner 2. Datei steht #NV bei der Anzahl der Paletten. Hat das was zu bedeuten, oder ist das nur ein Kopierfehler?

Aber eine Nullaufteilung lässt sich nicht verhindern, wenn die Anzahl der Gebinde größer als die Anzahl der aufzuteilenden Paletten ist (oder gibt es auch halbe Paletten?).

Gruß

M.O.


Antwort noch nicht bewertet Als gute Antwort bewerten
Antwort 7 von M.O. vom 19.05.2017, 11:30 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hallo Gianna,

hier die verbesserte und schnellere Version:

Sub aufteilen_neu()
Dim lngLetzte As Long
Dim arrDaten As Variant
Dim arrAufteilung As Variant
Dim lngZeile As Long
Dim lngSumme As Long
Dim lngPaletten As Long
Dim lngGebinde As Long
Dim varKennung As Variant
Dim p As Long
Dim g As Long

'letzte Zeile in Spalte ermitteln
lngLetzte = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row

'Array für Daten redimensionren
ReDim arrDaten(lngLetze, 4)
'Daten der Spalten B bis E ab Zeile 2 in Array einlesen
arrDaten = ActiveSheet.Range(Cells(2, 2), Cells(lngLetzte, 5))

'alle Daten durchlaufen und Aufteilung generieren
For lngZeile = 1 To UBound(arrDaten, 1)
  'Prüfen, ob Anzahl Paletten eine Zahl ist
  If IsNumeric(arrDaten(lngZeile, 1)) = True Then
      'Prüfen, ob neue Kennung
    If varKennung <> arrDaten(lngZeile, 4) Then
      'falls ja, dann
      varKennung = arrDaten(lngZeile, 4)     'neue Kennung in Variable schreiben
      lngPaletten = arrDaten(lngZeile, 1)    'Anzahl der Paletten in Varible schreiben
      lngGebinde = arrDaten(lngZeile, 2)     'Anzahl der Gebinde in Variable schreiben
      'Array für Aufteilung redimensionieren = Anzahl der Gebinde
      ReDim arrAufteilung(lngGebinde)
      'nun Paletten aufteilen
      lngSumme = 0          'Variable für Kontrollsumme auf Null setzen
      For p = 1 To lngPaletten
         For g = 1 To lngGebinde
           If lngSumme < lngPaletten Then
             arrAufteilung(g) = arrAufteilung(g) + 1
             lngSumme = lngSumme + 1
           End If
         Next g
      Next p
      'Aufteilung in Datei schreiben
      For g = 1 To lngGebinde
        If arrAufteilung(g) = 0 Then
              ActiveSheet.Cells(lngZeile + g, 1) = 0   'falls Feld in Aufteilung leer, Null in Zelle schreiben
          Else
              ActiveSheet.Cells(lngZeile + g, 1) = arrAufteilung(g)  'ermittelte Aufteilung in Zelle schreiben
        End If
      Next g
    End If
   Else
     ActiveSheet.Cells(lngZeile + 1, 1) = "Anzahl Paletten ist keine Zahl"
  End If
Next lngZeile
End Sub


Schau mal, ob die Aufteilung nun besser ist.

Gruß

M.O.


Antwort noch nicht bewertet Als gute Antwort bewerten
Antwort 8 von gianna vom 19.05.2017, 13:35 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hallo M.O.,

vielen Dank vorweg für deine große Hilfe.

Leider rechnet das Makro jetzt was komisches aus. Entweder die aufgeteilte Menge ist jetzt doppelt so groß wie die Anzahl der Gebinde-IDs oder gleich der Anzahl der Gebinde-IDs.

Ein Bezug zu der Palettenanzahl ist jetzt völlig weg. Ich bin aber gerade am rumprobieren und hoffe den Fehler zu finden.

Im Anhang das Ergebnis wenn das Makro durchläuft:

http://www84.zippyshare.com/v/hzSAwqrE/file.html

Falls Dir ad hoc einfällt was da gerade schief geht bzw. ich einen Fehler mache würde ich mich über eine Antwort sehr freuen.

Beste Grüße
Gianna


Antwort noch nicht bewertet
Antwort 9 von M.O. vom 19.05.2017, 16:27 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hallo Gianna,

bei deiner in Antwort 5 geposteten Datei war die Kennung in Spalte, jetzt ist sie in Spalte D. Deshalb funktioniert das Makro nicht mehr korrekt.

Hier das angepasste Makro zu deiner neuen Datei:

Sub aufteilen_neu()

Dim lngLetzte As Long
Dim arrDaten As Variant
Dim arrAufteilung As Variant
Dim lngZeile As Long
Dim lngSumme As Long
Dim lngPaletten As Long
Dim lngGebinde As Long
Dim varKennung As Variant
Dim p As Long
Dim g As Long

'letzte Zeile in Spalte ermitteln
lngLetzte = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row

'Array für Daten redimensionren
ReDim arrDaten(lngLetze, 4)
'Daten der Spalten B bis E ab Zeile 2 in Array einlesen
arrDaten = ActiveSheet.Range(Cells(2, 2), Cells(lngLetzte, 5))

'alle Daten durchlaufen und Aufteilung generieren
For lngZeile = 1 To UBound(arrDaten, 1)
  'Prüfen, ob Anzahl Paletten eine Zahl ist
  If IsNumeric(arrDaten(lngZeile, 1)) = True Then
      'Prüfen, ob neue Kennung
    If varKennung <> arrDaten(lngZeile, 3) Then
      'falls ja, dann
      varKennung = arrDaten(lngZeile, 3)     'neue Kennung in Variable schreiben
      lngPaletten = arrDaten(lngZeile, 1)    'Anzahl der Paletten in Varible schreiben
      lngGebinde = arrDaten(lngZeile, 2)     'Anzahl der Gebinde in Variable schreiben
      'Array für Aufteilung redimensionieren = Anzahl der Gebinde
      ReDim arrAufteilung(lngGebinde)
      'nun Paletten aufteilen
      lngSumme = 0          'Variable für Kontrollsumme auf Null setzen
      For p = 1 To lngPaletten
         For g = 1 To lngGebinde
           If lngSumme < lngPaletten Then
             arrAufteilung(g) = arrAufteilung(g) + 1
             lngSumme = lngSumme + 1
           End If
         Next g
      Next p
      
      'Aufteilung in Datei schreiben
      For g = 1 To lngGebinde
        If arrAufteilung(g) = 0 Then
              ActiveSheet.Cells(lngZeile + g, 1) = 0   'falls Feld in Aufteilung leer, Null in Zelle schreiben
          Else
              ActiveSheet.Cells(lngZeile + g, 1) = arrAufteilung(g)  'ermittelte Aufteilung in Zelle schreiben
        End If
      Next g
    End If
   Else
     ActiveSheet.Cells(lngZeile + 1, 1) = "Anzahl Paletten ist keine Zahl"
  End If
Next lngZeile

End Sub

Gruß
M.O.


Antwort noch nicht bewertet Als gute Antwort bewerten
Diese Antwort hat das Problem gelöst!
Antwort 10 von gianna vom 22.05.2017, 11:19 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hallo M.O.,

aha da lag der Fehler.

Vielen Dank. Das Makro macht jetzt genau das was ich brauche und ich kann es in meine Simulation einbinden.

Vielen lieben Dank für die Hilfe.

Beste Grüße
Gianna


Antwort noch nicht bewertet
Antwort 11 von M.O. vom 22.05.2017, 11:34 Mißbrauch, Beleidigungen und Blödsinn den Moderatoren melden

Hallo Gianna,

danke für die Rückmeldung und gern geschehen :-).

Gruß

M.O.


Antwort noch nicht bewertet Als gute Antwort bewerten




Antwort schreiben
    Bitte einen 'Nickname' wählen.
Nickname:*
    (eMail-Adresse wird nicht veröffentlicht.)
eMail:
Nachricht: Ich möchte bei Antworten benachrichtigt werden.
    Hilfe zur Beitragsformatierung gibts [hier]
                   
Antwort:*
  Die Nutzungsbedingungen habe ich gelesen und akzeptiert.

MACHEN SIE IHRE WEBSITE ATTRAKTIVER
Sie haben eine eigene Website und wollen Ihre Besucher auf den Supportnet-Service aufmerksam machen? Kopieren Sie einfach den Quellcode in Ihre Seite und jeder Besucher Ihrer Seite kann direkt auf die Supportnet-Datenbank zugreifen.

My Supportnet


SUCHE

Gruppen im Forum
Betriebsysteme
Software
Hardware
Netzwerk
Programmierung
Sonstiges

Impressum © 1997-2015 SupportNet
Version: supportware 1.8.230E / 18.10.2010, Startzeit:Mon Jun 26 21:36:45 2017