Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Excel VBA Случайные числа без повторений / 5 сообщений из 5, страница 1 из 1
28.05.2013, 10:53
    #38276023
DON_DON
DON_DON
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Excel VBA Случайные числа без повторений
Здравствуйте!
Как при выборке случайных чисел, избежать повторений.Кто сталкивался,помогите пожалуйста.Заранее спасибо.
Вот код
Sub Generate()
Worksheets("0").Activate
Cells.Select
Selection.ClearContents
Range("A1").Select
Dim test_count As Integer
Dim y As Integer
Dim quest_count_I As Integer
Dim quest_count_II As Integer
Dim max_quest_II, max_quest As Integer
Dim min_quest_II As Integer
Dim list As String
Dim m() As Integer
Dim WRD
Set WRD = CreateObject("Word.Application")
WRD.Visible = True
WRD.Documents.Open "D:\test.doc" ' !!!!
test_count = 3 '
quest_count_I = 5 '
quest_count_II = 8 '
min_quest_II = 37
max_quest_II = 43 '
max_quest = 36
sea = 2
ReDim m(quest_count_I)
Randomize
For i = 1 To test_count Step 1
WRD.Selection.Font.Size = 14
WRD.Selection.Font.Bold = True
WRD.Selection.TypeText Text:="Ýêçàìåíàöèîííûé ëèñò " + CStr(i)
WRD.Selection.Font.Bold = wdToggle
WRD.Selection.TypeParagraph
WRD.Selection.Font.Size = 12
Worksheets("0").Cells(sea, 1).Value = "Ýêçàìåíàöèîííûé ëèñò " + CStr(i)
sea = sea + 1
For j = 1 To quest_count_I Step 1
Worksheets("Îñíîâíîé áëîê").Activate
ActiveCell.SpecialCells(xlLastCell).Select
MaxString = ActiveCell.Row
num = Int(Rnd * max_quest) + 1
tmp = 0
For Z = 1 To MaxString Step 1
y = m(Z): m(Z) = m(num): m(num) = y
If (Int(Cells(Z, 2).Value) = num) Then
' MsgBox (Cells(Z, 3).Value)
tmp = Z
Exit For
End If
Next Z
If tmp = 0 Then
str1 = "Íîìåð âîïðîñà íå íàéäåí: " + CStr(num)
MsgBox (str1)
End If
Next j
sea = sea + 1
Next i

End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
28.05.2013, 10:56
    #38276028
Shocker.Pro
Shocker.Pro
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Excel VBA Случайные числа без повторений
Учимся использовать тэги оформления кода - FAQ
Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
Sub Generate()
    Worksheets("0").Activate
    Cells.Select
    Selection.ClearContents
    Range("A1").Select
Dim test_count As Integer 
Dim y As Integer
Dim quest_count_I As Integer 
Dim quest_count_II As Integer
Dim max_quest_II, max_quest As Integer 
Dim min_quest_II As Integer 
Dim list As String 
Dim m() As Integer
    Dim WRD
    Set WRD = CreateObject("Word.Application")
    WRD.Visible = True
    WRD.Documents.Open "D:\test.doc" ' !!!!  
    test_count = 3 ' 
    quest_count_I = 5 ' 
    quest_count_II = 8 ' 
    min_quest_II = 37
    max_quest_II = 43 ' 
    max_quest = 36
    sea = 2
    ReDim m(quest_count_I)
    Randomize
    For i = 1 To test_count Step 1
         WRD.Selection.Font.Size = 14
         WRD.Selection.Font.Bold = True
         WRD.Selection.TypeText Text:="Ýêçàìåíàöèîííûé ëèñò " + CStr(i)
         WRD.Selection.Font.Bold = wdToggle
         WRD.Selection.TypeParagraph
         WRD.Selection.Font.Size = 12
         Worksheets("0").Cells(sea, 1).Value = "Ýêçàìåíàöèîííûé ëèñò " + CStr(i)
         sea = sea + 1      
        For j = 1 To quest_count_I Step 1 
          Worksheets("Îñíîâíîé áëîê").Activate 
          ActiveCell.SpecialCells(xlLastCell).Select
          MaxString = ActiveCell.Row    
          num = Int(Rnd * max_quest) + 1
            tmp = 0
            For Z = 1 To MaxString Step 1
             y = m(Z): m(Z) = m(num): m(num) = y
                If (Int(Cells(Z, 2).Value) = num) Then
                 ' MsgBox (Cells(Z, 3).Value)
                    tmp = Z
                    Exit For 
                End If
            Next Z   
            If tmp = 0 Then
               str1 = "Íîìåð âîïðîñà íå íàéäåí: " + CStr(num)
               MsgBox (str1) 
            End If
                     Next j
  sea = sea + 1
    Next i

End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
05.06.2013, 15:15
    #38286889
Aster32
Aster32
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Excel VBA Случайные числа без повторений
Какой то "индусский код". Вы бы хоть задачу сформулировали.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
05.06.2013, 16:43
    #38287094
lbppb
lbppb
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Excel VBA Случайные числа без повторений
DON_DON,

На скорую руку (не самый эффективный метод), не вдаваясь в детали и тем более в ваш код, можно так. А вообще в Интернете полно готовых вариантов.

Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
Sub GenerateUniqueRandomNumbers()

Dim r As Double
Dim arr() As Double
Dim i As Double
Dim k As Double
Dim amount As Double
Dim skip As Boolean
Dim t

'Choose how many unique numbers is required.
amount = 10000

ReDim arr(amount - 1)

'Generate array with chosen amount of unique numbers.
t = Timer
i = 0
Do While i < amount
    r = Rnd
    skip = False
    For k = 0 To i
        If arr(k) = r Then
            skip = True
            Exit For
        End If
    Next k
        
    If Not skip Then
        arr(i) = Rnd
        i = i + 1
    End If
Loop
t = Timer - t

'List generated numbers.
For i = 0 To amount - 1
    Debug.Print i + 1 & ") " & arr(i)
Next i

'Time spent to generate array.
Debug.Print t

End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
05.06.2013, 18:31
    #38287282
Akina
Akina
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Excel VBA Случайные числа без повторений
Если надо именно уникальные рандомы - их лучше накапливать в коллекции, где ключи элементов - строковые представления рандомов, а значения - числовые. В цикле DO-LOOP UNTIL Collection.Items.Count = требуемое_количество. Дубли отсекутся сами - только не забыть ON ERROR RESUME NEXT.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Excel VBA Случайные числа без повторений / 5 сообщений из 5, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
созд. / загр.: 451ms
Закрыть
start [/forum/topic.php?fid=61&mobile=1&tid=2174758]:
 0ms
get settings:
 9ms
get forum list:
 13ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 31ms
get topic data:
 11ms
get forum data:
 2ms
get page messages:
 48ms
get tp. blocked users:
 2ms
others: 329ms
total:  451ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]