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

• #51901 Delila_1 veterán DasBoot #51899

  Új Válasz 2023-12-03 15:08:29 #51901

  Ú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 DasBoot #51899 üzenetére

  Kiegészítettem bela85 linkelt makróját úgy, hogy a számokat emelkedő sorrendbe rakja.

  Sub LottoSzamok()
    Dim Rng As Range, WorkRng As Range, xNumbers(49) As Integer, xTitleId As String
    Dim xIndex As Integer, xNum As Integer, Cim As Range, Lapnev As String
    
    Lapnev = Selection.Worksheet.Name
    On Error Resume Next
    xTitleId = "Véletlen számok"
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Melyik cellában kezdődjön?", xTitleId, WorkRng.Address, Type:=8)
    Set WorkRng = WorkRng.Range("A1")
    For xIndex = 1 To 49
        xNumbers(xIndex) = xIndex
    Next
    For xIndex = 1 To 6
        xNum = 1 + Application.Round(Rnd * (49 - xIndex), 0)
        WorkRng.Offset(0, xIndex - 1).Value = xNumbers(xNum)
        xNumbers(xNum) = xNumbers(50 - xIndex)
    Next
    
    Set Cim = Range(WorkRng.Range("A1"), WorkRng.Offset(0, 5))
    Range(Cim.Address).Select
    ActiveWorkbook.Worksheets(Lapnev).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(Lapnev).Sort.SortFields.Add2 Key:=Range(Selection.Address), _
        SortOn:=xlSortOnValues, Order:=xlAscending
    With ActiveWorkbook.Worksheets(Lapnev).Sort
        .SetRange Range(Selection.Address)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlLeftToRight
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

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