Új hozzászólás Aktív témák

• #14078 #90999040 törölt tag detroitrw #14038

  Új Válasz 2012-06-20 09:27:01 #14078

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  

  #90999040

  törölt tag

  válasz detroitrw #14038 üzenetére

  Szerintem nem annyira értelmezhetetlen.

  Egy sor -> egy szálat jelent. Pl. a fejléc a konkrét esetben:

  2427 2359 946 900 430 410 Hulladék Teljes Max darab

  Az egyik sor pedig:

  0 0 0 2 5 5 0 * 1

  Ez ezt jelenti egy szál esetén:
  0*2427 + 0*2359 + 0*946 + 2*900 + 5*430 + 5*410 = 6000

  Értelemszerűen a hulladék 0%. Teljes oszlopban a * azt jelenti, hogy erre a szálra már a legrövidebb(410 mm-es) darab sem férne rá.
  A max darab ebből a szálból azért 1, mert ha pl. 2 lenne, akkor már a 430 mm-esből 10 darab jönne ki, holott összesen csak 6 darab kell belőle.

  Az adott linken levő programot fogalmam nincs, hogy lehetne működésre bírni(már csak azért sem, mert amit meg tudok csinálni, abból a legritkább esetben használok kész programot). De más talán majd megnézi...

  Viszont még az elején említettem a random generálást. Ezt kipróbáltam. Ha 20 szálra keresek, akkor nagyon rövid idő alatt kidob egy lehetséges megoldást. Ha erre lecseréled az előző makrót, akkor láthatod az eredményt.

  Sub frissit()
  Set cel = Range("D1")
  Range("D1:V" & Rows.Count).ClearContents
  korrekcio = 1
  maxprobalkozas = 10000000
  
  talalatszam = 0
  sor = cel.Row
  oszlop = cel.Column
  Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
  hosszok = Application.Transpose(Range("A2:A7"))
  szalhossza = Range("A10").Value
  darabok = Application.Transpose(Range("B2:B7"))
  osszdarab = 0
  osszhossz = 0
  For i = 1 To UBound(darabok)
  osszdarab = osszdarab + darabok(i)
  osszhossz = osszhossz + hosszok(i) * darabok(i)
  Next
  mindarab = Application.RoundUp(osszhossz / szalhossza, 0)
  ReDim tomb(0 To osszdarab - 1)
  aktindex = 0
  For i = 1 To UBound(darabok)
  For j = 0 To darabok(i) - 1
  tomb(aktindex) = hosszok(i)
  aktindex = aktindex + 1
  Next
  Next
  'kezdődik a tippözön :)
  Randomize
  For i = 1 To maxprobalkozas
  For j = 0 To UBound(tomb)
  R = Int((osszdarab) * Rnd())
  R1 = Int((osszdarab) * Rnd())
  If R <> R1 Then
  temp = tomb(R)
  tomb(R) = tomb(R1)
  tomb(R1) = temp
  End If
  Next
  szalakszama = 0
  akthossz = 0
  temphossz = 0
  For j = 0 To UBound(tomb)
  If akthossz + tomb(j) = szalhossza Then
  temphossz = temphossz + akthossz + tomb(j)
  akthossz = 0
  szalakszama = szalakszama + 1
  ElseIf akthossz + tomb(j) > szalhossza Then
  temphossz = temphossz + akthossz
  akthossz = tomb(j)
  szalakszama = szalakszama + 1
  Else
  akthossz = akthossz + tomb(j)
  End If
  Next
  If temphossz < osszhossz Then szalakszama = szalakszama + 1
  If szalakszama <= mindarab + korrekcio Then
  talalatszam = talalatszam + 1
  akthossz = 0
  aktoszlop = oszlop
  s = ""
  For j = 0 To UBound(tomb)
  If akthossz + tomb(j) = szalhossza Then
  akthossz = 0
  Cells(sor, aktoszlop) = tomb(j)
  sor = sor + 1
  aktoszlop = oszlop
  ElseIf akthossz + tomb(j) > szalhossza Then
  akthossz = tomb(j)
  sor = sor + 1
  aktoszlop = oszlop
  Cells(sor, aktoszlop) = tomb(j)
  aktoszlop = aktoszlop + 1
  ElseIf j = UBound(tomb) Then
  Cells(sor, aktoszlop) = tomb(j)
  aktoszlop = aktoszlop + 1
  Else
  Cells(sor, aktoszlop) = tomb(j)
  aktoszlop = aktoszlop + 1
  akthossz = akthossz + tomb(j)
  End If
  Next
  sor = cel.Row + talalatszam * (mindarab + korrekcio + 1)
  aktoszlop = oszlop
  Exit Sub
  End If
  Next
  End Sub

  Az elején a korrekcio = 1 állítja be, hogy nem az elméleti minimális szálmennyiségre akarunk keresni, hanem 1-el többre(jelen esetben 20-ra).
  Nálam ez nagyon gyorsan beleszalad egy lehetőségbe.
  Persze még van rajt bőven finomítanivaló, de ezek már csak részletkérdések. A Exit sub miatt kilép az első találat után, ha ez nincs benne, akkor többet is keres, egészen a maxprobalkozas-ig. Valószínűleg nincs szükség annyi random számra, amennyi a tomb elemeinek a száma->ezt ki lehet tapasztalni...

Új hozzászólás Aktív témák