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

• #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

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