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

• #26489 Delila_1 veterán Sanki #26488

  Új Válasz 2015-04-08 17:48:04 #26489

  Ú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

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Sanki #26488 üzenetére

  Kipróbáltad a később küldött makrót?

  Változó mennyiségű név és terület esetén is működik, egyedül azt a feltételt nem teljesíti, hogy minden terület legalább egyszer szerepeljen minden hónapban. Írtam, hogy ez az eszkimók és fókák esete.

  Ja, közben bővítetted a hsz-t.

• #26468 Delila_1 veterán Sanki #26461

  Új Válasz 2015-04-08 13:32:53 #26468

  Ú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

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Sanki #26461 üzenetére

  Most tetszőleges név, és tetszőleges terület esetén is elkészíti a beosztást. Nincs benne viszont, hogy minden terület legalább 1× szerepeljen. Nem minden esetben van megfelelő megoldás, pl. ha sok az eszkimó (ember), és kevés a fóka (terület).

  Sub Terulet()
  Dim sor As Integer, oszlop As Integer, vel As Integer, i As Integer, soruj As Integer
  Dim NevUsor As Long, TerUsor As Long
  Dim tomb()
  
  NevUsor = Range("A" & Rows.Count).End(xlUp).Row
  TerUsor = Range("G" & Rows.Count).End(xlUp).Row
  ReDim tomb(1 To TerUsor)
  
  Application.ScreenUpdating = False
  
  Range("B4:E" & NevUsor) = ""
  
  For sor = 4 To NevUsor
  UjSor:
  For oszlop = 2 To 5
  UJRA:
  Randomize
  vel = Round(Rnd() * (TerUsor - 3) + 3, 0) '
  If tomb(vel) > 0 Then GoTo UJRA ' Ha volt már a sorszám, akkor újra generál
  tomb(vel) = 1
  Next
  
  oszlop = 2
  For i = 1 To TerUsor 'Beírja a területet, lenullázza a tömböt
  If tomb(i) = 1 Then
  Cells(sor, oszlop) = Cells(i, "G")
  oszlop = oszlop + 1
  End If
  tomb(i) = 0
  Next i
  
  For soruj = 3 To TerUsor 'Van-e 3× a terület?
  If Application.CountIf(Range("$B$4:$E" & NevUsor), Range("G" & soruj)) > 3 Then
  Range("B" & sor & ":E" & sor) = ""
  For i = 1 To TerUsor
  tomb(i) = 0
  Next
  GoTo UjSor
  Exit For
  End If
  Next
  Next
  
  Application.ScreenUpdating = True
  End Sub

• #26463 Delila_1 veterán Sanki #26461

  Új Válasz 2015-04-08 13:15:49 #26463

  Ú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

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Sanki #26461 üzenetére

  A számokat kell értelemszerűen átírni a makróban.

• #26440 Delila_1 veterán Sanki #26433

  Új Válasz 2015-04-08 07:29:43 #26440

  Ú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

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Sanki #26433 üzenetére

  A makró összeállítja a területek kiosztását.

  Sub Terulet()
  Dim sor As Integer, oszlop As Integer, vel As Integer, i As Integer, soruj As Integer
  Dim tomb(1 To 36) As Integer
  
  Application.ScreenUpdating = False
  
  Range("B4:E23") = ""
  
  For sor = 4 To 23
  UjSor:
  For oszlop = 2 To 5
  UJRA:
  Randomize
  vel = Round(Rnd() * 33 + 3, 0) '3 és 36 közötti véletlenszámot ad
  If tomb(vel) > 0 Then GoTo UJRA ' Ha volt már a sorszám, akkor újra generál
  tomb(vel) = 1
  Next
  
  oszlop = 2
  For i = 1 To 36 'Beírja a területet, lenullázza a tömböt
  If tomb(i) = 1 Then
  Cells(sor, oszlop) = Cells(i, "G")
  oszlop = oszlop + 1
  End If
  tomb(i) = 0
  Next i
  
  For soruj = 3 To 36 'Van-e 3× a terület?
  If Application.CountIf(Range("$B$4:$E$23"), Range("G" & soruj)) > 3 Then
  Range("B" & sor & ":E" & sor) = ""
  For i = 1 To 36
  tomb(i) = 0
  Next
  GoTo UjSor
  Exit For
  End If
  Next
  Next
  
  Application.ScreenUpdating = True
  End Sub

• #26439 hhheni tag Sanki #26438

  Új Válasz 2015-04-08 07:26:02 #26439

  Ú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

  Privát üzenet küldése

  

  hhheni

  tag

  válasz Sanki #26438 üzenetére

  ez mindig azt a sorrendet fogja adni, ahogyan g3-tól kezdve vannak
  ha ez is szempont, akkor a h oszlopban mellé teszel vél() függvénnyel egy oszlopot, és havonta rendezed
  persze, lehetnek még finomító kívánságok, pl.:
  1. a 34 területből ne minden hónapban legyenek ugyanazok 3-szor ill. 2-szer,
  2. egy héten belül ne kerüljön sorra 2* ugyanaz a terület stb.

• #26437 hhheni tag Sanki #26433

  Új Válasz 2015-04-07 22:36:04 #26437

  Ú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

  Privát üzenet küldése

  

  hhheni

  tag

  válasz Sanki #26433 üzenetére

  én így csinálnám:
  a területek tömbje legyen mondjuk g3:g82 (ez épp 4*20 db, amennyi kell, ha nincs annyi, akkor ismétled a terület1, terület 2, ...-t egymás alá annyiszor, hogy elérjen g82-ig
  b4-be beírod: =index($g$3:$g$82;(sor()-4)*4+oszlop()-1)
  lemásolod e23-ig

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