jeg prøver at øve mig i vba og derfor forsøgt at lave en simulering i excel vba, men synes ikke helt det spiller. Jeg har forsøgt at lave et transportbånd med chokolade. Chokoladen kommer ind en efter en og bliver derefter vejet hvorefter det skal hen i 1 ud af 3 skåle. Jeg har sat vægten til mellem 40 - 70 gram. Der skal være mindst 7 stykker cholade i skålen og de skal veje mindst 400 gram. Når det er opfyldt skiftes skålen ud.
det her er koden indtil videre som jeg har lavet, jeg ved ikke om jeg prøver at gøre det for indviklet eller der er en mere simpel måde....
Option Explicit Option Base 1
Sub SimMasterFirstBestWorstOutputPaaArk() Dim MinVaegt As Integer 'Mindste vægt af en enhed Dim MaxVaegt As Integer 'Største vægt af en enhed Dim Q As Integer Dim AntalEnhederIalt As Integer Dim MaxBins As Integer Dim EnhedNr As Integer Dim BinIdx As Integer Dim BinNr As Integer Dim LukBinNr As Integer Dim Vaegt As Integer Dim AntalLukkedeBins As Integer Dim AntalBenyttedeBins As Integer Dim RestKap() As Integer
Dim W As Worksheet Dim FoersteRaekke As Integer Dim RNr As Integer
Set W = Worksheets.Add(after:=Worksheets(Worksheets.Count))
Da jeg ikke helt er klar over hvad du ønsker at opnå, er det ikke sikkert at svaret er det du ønsker.
Option Base 1
Sub SimMasterFirstBestWorstOutputPaaArk() Dim MinVaegt As Integer 'Mindste vægt af en enhed Dim MaxVaegt As Integer 'Største vægt af en enhed Dim Q As Integer Dim AntalEnhederIalt As Integer Dim MaxBins As Integer Dim EnhedNr As Integer Dim BinIdx As Integer Dim BinNr As Integer Dim LukBinNr As Integer Dim Vaegt As Integer Dim AntalLukkedeBins As Integer Dim AntalBenyttedeBins As Integer Dim RestKap() As Integer Dim x As Long, lBin As Long, dSum As Double, lantal As Long Dim W As Worksheet Dim FoersteRaekke As Integer Dim RNr As Integer Dim MinPrBin As Long Dim Arr()
Set W = Worksheets.Add(after:=Worksheets(Worksheets.Count))
lBin = 1 For x = 1 To AntalEnhederIalt If dSum + Arr(x, 2) < Q And lantal <= MinPrBin Then dSum = dSum + Arr(x, 2) Arr(x, 4) = dSum lantal = lantal + 1 Arr(x, 3) = lBin Else Arr(x, 3) = lBin Arr(x, 4) = dSum + Arr(x, 2) dSum = 0 lantal = 0 lBin = lBin + 1 End If Next W.Range("C16:F" & x + 14) = Arr W.Range("B13") = lBin End Sub
Sub FillArray(Enheder, myarray, mini, maxi) Dim x As Long maxi = maxi + 1 For x = 1 To Enheder myarray(x, 1) = x myarray(x, 2) = Int(Rnd() * (maxi - mini) + mini) Next End Sub
hej jeg vil gerne give dig de 100 point for din ihærdighed, men jeg fandt faktisk en løsning i mellemtiden....
som et lile bonus spørgsmål, så vil jeg høre om du ved hvad man skal have med og hvad man eventuelt kunne skrive, hvis man skal lave et regelsæt til ovenstående problemstilling.
dette er mine beslutningsregler som er en public function modul
For binidx = 1 To antalbins If RestKap(binidx) < 500 Or antalstyk(binidx) < 7 Then 'Der er plads i denne bin If bedstebin = 0 Or RestKap(binidx) < MinRestKap Then bedstebin = binidx
MinRestKap = RestKap(binidx) End If End If
Next binidx
VaelgBinBestFit = bedstebin
og i et andet modul har jeg dette...
Sub SimMasterFirstBestWorstOutputPaaArk() Dim MinVaegt As Integer 'Mindste vægt af en enhed Dim MaxVaegt As Integer 'Største vægt af en enhed Dim Q As Integer 'Kapacitet af hver bin Dim AntalEnhederIalt As Integer 'Antal ankommende enheder ialt i simulationen Dim MaxBins As Integer 'Max. antal bins, som kan være åbne samtidigt Dim EnhedNr As Integer Dim binidx As Integer 'Bruges som tæller til at gennemløbe RestKap-tabel. Dim binnr As Integer Dim lukbinnr As Integer Dim vaegt As Integer Dim AntalLukkedeBins As Integer Dim AntalBenyttedeBins As Integer Dim RestKap() As Integer Dim startstyk As Integer Dim antalstyk() As Integer Dim stykiskaal As Integer Dim sum As Integer
Dim W As Worksheet Dim FoersteRaekke As Integer Dim RNr As Integer
Set W = Worksheets.Add(after:=Worksheets(Worksheets.Count)) 'Tilføjelse af et worksheet, som placeres til sidst i samlingen af worksheets. 'Objektvariablen W refererer herefter til dette ark. 'Dette ark er nu det aktive ark.
W.Range(Cells(14, 5), Cells(14, 4 + MaxBins)).Merge W.Range(Cells(14, 5), Cells(14, 4 + MaxBins)).HorizontalAlignment = xlCenter 'Ovenstående to linier kræver, at W er det aktiverede ark, hvilket ikke 'nødvendigvis er tilfældet, hvis f.eks. W sættes til at referere til et 'eksisterende ark. W kan aktiveres med kommandoen W.Activate.
For binnr = 1 To MaxBins W.Cells(15, binnr + 4) = "Bin " & binnr Next
If binnr = 0 Then 'Der er ikke plads i nogen af de åbne bins ... Or
ReDim RestKap(binidx) ReDim antalstyk(binidx)
lukbinnr = FindBinMedMinRestKap(MaxBins, RestKap) AntalLukkedeBins = AntalLukkedeBins + 1 antalstyk(lukbinnr) = startstyk + 1 RestKap(lukbinnr) = Q + vaegt 'Den lukkede bin erstattes af en tom bin, som enheden fyldes i W.Cells(RNr, lukbinnr + 4) = RestKap(lukbinnr) W.Cells(RNr, lukbinnr + 4).Interior.Color = RGB(0, 255, 0) Else 'Placer denne enhed i bin nr. BinNr If RestKap(binnr) = Q Then 'AntalLukkedeBins = AntalLukkedeBins + 1 'W.Range("L13") = AntalLukkedeBins W.Cells(RNr, binnr + 4).Interior.Color = RGB(0, 255, 0) 'Denne bin er tom før den aktuelle enhed fyldes i 'Dette sker kun (højst) én gang pr. kolonne End If antalstyk(binnr) = antalstyk(binnr) + 1 RestKap(binnr) = RestKap(binnr) + vaegt
W.Cells(RNr, binnr + 4) = RestKap(binnr)
W.Cells(RNr, binnr + 7) = antalstyk(binnr)
End If
Next EnhedNr
'De bins, som er åbne og endnu ikke lukkede, tælles med i antal benyttede bins: AntalBenyttedeBins = AntalLukkedeBins
For binidx = 1 To MaxBins If RestKap(binidx) < 500 Then 'Denne bin er ikke tom AntalBenyttedeBins = AntalBenyttedeBins + 1 End If Next
jeg vil høre om du ved hvordan man summere tallene i en bestemt række.....f.eks hvis jeg gerne vil summere alle tallene i række B i mit excel ark, hvor skriver jeg så det i kode??
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
