Delila10
2010.11.17
|
|
0 0
13298
|
Rájöttem a hibára, most már nem ad egyforma sorokat.
Sub veletlen_2() Dim db As Integer, sor As Integer, sor_1 As Integer Dim usor As Integer, f As Boolean, uoszlop As String Sheets(1).Select usor = ActiveSheet.UsedRange.Rows.Count db = InputBox("Hány sort akarsz másolni?") sor_1 = 2 For i = 1 To db sor = Int(Rnd() * usor) + 2 'Címsort feltételezve Rows(sor).EntireRow.Copy Sheets(2).Rows(sor_1) sor_1 = sor_1 + 1 Next Sheets(2).Select db = db + 1 uoszlop = Chr(ActiveSheet.UsedRange.Columns.Count + 64) Do Range("A2:" & uoszlop & db).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal f = False For i = 3 To db If Cells(i, 1) = Cells(i - 1, 1) Then sor = Int(Rnd() * usor) + 2 Sheets(1).Rows(sor).EntireRow.Copy Rows(i) f = True End If Next Loop While f <> False Range("A2:" & uoszlop & db).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _ xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ DataOption1:=xlSortNormal 'Ellenőrzés uoszlop = Chr(ActiveSheet.UsedRange.Columns.Count + 65) Range(uoszlop & "2:" & uoszlop & db + 1) = "=if(A2=A3, ""Egyforma"","""")" End Sub
|
Előzmény: Delila10 (13297)
|
|