Hirdetés

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

  • Carasc0

    őstag

    Sziasztok!

    Tavaly nyáron sok segítséget kaptam itt. Azt a bizonyos segítséget mai napig használom, de most kellene némi kiegészítés/módosítás. Lényegre térek! Adott egy kód:

    Sub Kever()
    Dim sor As Integer
    Application.ScreenUpdating = False
    Range("A1:A20").Copy Range("B1")

    For sor = 1 To 20
    Cells(sor, "C") = "=RAND()"
    Cells(sor, "C") = Cells(sor, "C").Value
    Next

    ActiveWorkbook.Worksheets("BÓNUSZ GENERÁTOROK").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("BÓNUSZ GENERÁTOROK").Sort.SortFields.Add Key:=Range("C1:C20"), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("BÓNUSZ GENERÁTOROK").Sort
    .SetRange Range("B1:C20")
    .Header = xlGuess
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With

    Range("C1:C20").ClearContents
    Application.ScreenUpdating = True
    End Sub

    Az A1:A20-ba ha megadom 1-20-ig a számokat, akkor azt nekem összekeverje kiadja a C1:C20-ba. Ez teljesen jó eddig.

    Na most a jön a neheze:

    Adott 2db cellatartomány. Az egyik az A1:A25 Ebbe ugyanúgy 1-25-ig kerülnek bele a számok. A másik cellatartomány legyen a C1:C50.
    Feladat:Az A1:A25-ben lévő számokat úgy keverje össze, hogy kihagyás nélkül feltöltse a C1:C25 tartományt, a maradék 5db szám pedig a C26:C50-ben elszórtan! kerüljenek. Tehát a fenti kódot kéne így még megspékelni. :R

    Nagyon hálás lennék! :R

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