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

• #21267 Delila_1 veterán Esterka #21259

  Új Válasz 2014-04-15 13:53:47 #21267

  Ú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 Esterka #21259 üzenetére

  Sikerült összehozni a véletlen helyeket.

  A makró szazalek = 14.8 sorában a 14.8 helyett beírod azt a számot, ahány százalékban legyen 1-es a kijelölésedben. Tizedes törtet is írhatsz, tizedes ponttal, mint most.

  Kijelölöd a tartományt, és indítod a makrót.

  Sub XEgy()
  Dim Cellaszam As Long, sor As Long, oszlop As Long, Db As Long
  Dim CV, szazalek As Single
  
  Selection = ""
  Cellaszam = Selection.Cells.Count
  sor = Selection.Rows.Count
  oszlop = Selection.Columns.Count
  szazalek = 14.8
  
  Db = 1
  
  Do While Db <= Round(szazalek * Cellaszam / 100, 0)
  sor = Int(Selection.Rows.Count * Rnd) + 1
  oszlop = Int(Selection.Columns.Count * Rnd) + 1
  If Selection(sor, oszlop) <> 1 Then
  Selection(sor, oszlop) = 1
  Db = Db + 1
  End If
  Loop
  
  For Each CV In Selection
  If CV <> 1 Then Range(CV.Address) = 0
  Next
  End Sub

• #21260 Delila_1 veterán Esterka #21259

  Új Válasz 2014-04-14 18:17:04 #21260

  Ú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 Esterka #21259 üzenetére

  A makró beírja a kijelölt területre a nullákat, majd az egyeseket. Azt majd valaki kitalálja, hogyan legyen ebből véletlenszerű elrendezés.

  Sub Nulla_Egy()
  sorok = Selection.Rows.Count
  oszlopok = Selection.Columns.Count
  ter = sorok * oszlopok
  
  egyDb = Round(ter / 100 * 12, 0)
  nullaDb = ter - egyDb
  
  For Each CV In Selection
  Range(CV.Address) = 0
  Db = Db + 1
  If Db >= nullaDb Then Exit For
  Next
  
  Selection.SpecialCells(xlCellTypeBlanks).Select
  Selection = 1
  End Sub

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