Здравствуйте! Помогите пожалуйста в решении проблемы. На Листе1 имеются данные 500 строк (в оригинале больше 300000), 10 столбцов $С : $L. Нужно вывести на Лист2 в случайном порядке (без дубликации строк) 300 значений строк в диапазоне C:L пример: C125:L125 C301:L301 C15:L15 C307:L307 C5:L5 C499:L499 и так 300 значений. Спасибо!!!
Здравствуйте! Помогите пожалуйста в решении проблемы. На Листе1 имеются данные 500 строк (в оригинале больше 300000), 10 столбцов $С : $L. Нужно вывести на Лист2 в случайном порядке (без дубликации строк) 300 значений строк в диапазоне C:L пример: C125:L125 C301:L301 C15:L15 C307:L307 C5:L5 C499:L499 и так 300 значений. Спасибо!!!djon2012
Sub djon2012() Dim i&, R&, a(), Arr(1 To 300, 1 To 10), k& R = Worksheets("Лист1").Cells(Rows.Count, 3).End(xlUp).Row With New Collection For i = 1 To R .Add i Next For i = 1 To 300 Randomize R = Int((.Count * Rnd) + 1) With Worksheets("Лист1") a = .Range("C" & R, "L" & R).Value End With For k = 1 To UBound(a, 2) Arr(i, k) = a(1, k) Next .Remove (R) Next End With Worksheets("Лист2").Range("A1").Resize(300, 10) = Arr Worksheets("Лист2").Activate End Sub
[/vba]
[vba]
Код
Sub djon2012() Dim i&, R&, a(), Arr(1 To 300, 1 To 10), k& R = Worksheets("Лист1").Cells(Rows.Count, 3).End(xlUp).Row With New Collection For i = 1 To R .Add i Next For i = 1 To 300 Randomize R = Int((.Count * Rnd) + 1) With Worksheets("Лист1") a = .Range("C" & R, "L" & R).Value End With For k = 1 To UBound(a, 2) Arr(i, k) = a(1, k) Next .Remove (R) Next End With Worksheets("Лист2").Range("A1").Resize(300, 10) = Arr Worksheets("Лист2").Activate End Sub
Большое, большущее Вам спасибо!!! Вы мне очень помогли, это то что мне было нужно. Макрос работает идеально. Сам бы я с моими ну очень скромными знаниями по VBA, ни за что не смог бы написать макрос. С Новым Годом Вас!!! Здоровья Вам и счастья, остальное дело наживное. И еще раз ооооогромное Вам спасибо, выручили.
Большое, большущее Вам спасибо!!! Вы мне очень помогли, это то что мне было нужно. Макрос работает идеально. Сам бы я с моими ну очень скромными знаниями по VBA, ни за что не смог бы написать макрос. С Новым Годом Вас!!! Здоровья Вам и счастья, остальное дело наживное. И еще раз ооооогромное Вам спасибо, выручили. djon2012
У меня получаются дублирующиеся строки (т.е. 2 строка, например 2 раза) удаление R (.Remove ®) только сужает диапазон для random
Если действительно нужны не повторяющиеся строки, получается надо добавлять ещё цикл проверяющий использовался ли этот номер уже в прошлом (не знаю, может есть другие варианты? а то получается количество циклов увеличивается на неизвестное число раз)
[vba]
Код
Sub djon2012() Dim i&, R&, a(), Arr(1 To 300, 1 To 11), k&, isExists, j& R = Worksheets("Лист1").Cells(Rows.Count, 3).End(xlUp).Row With New Collection For i = 1 To R .Add i Next Randomize For i = 1 To 300 R = Int((.Count * Rnd) + 1) With Worksheets("Лист1") a = .Range("C" & R, "L" & R).Value End With
isExists = False For j = 1 To i If Arr(j, 11) = R Then isExists = True Next If Not isExists Then For k = 1 To UBound(a, 2) Arr(i, k) = a(1, k) Next Arr(i, 11) = R Else i = i - 1 End If Next End With Worksheets("Лист2").Range("A1").Resize(300, 10) = Arr Worksheets("Лист2").Activate End Sub
[/vba]
У меня получаются дублирующиеся строки (т.е. 2 строка, например 2 раза) удаление R (.Remove ®) только сужает диапазон для random
Если действительно нужны не повторяющиеся строки, получается надо добавлять ещё цикл проверяющий использовался ли этот номер уже в прошлом (не знаю, может есть другие варианты? а то получается количество циклов увеличивается на неизвестное число раз)
[vba]
Код
Sub djon2012() Dim i&, R&, a(), Arr(1 To 300, 1 To 11), k&, isExists, j& R = Worksheets("Лист1").Cells(Rows.Count, 3).End(xlUp).Row With New Collection For i = 1 To R .Add i Next Randomize For i = 1 To 300 R = Int((.Count * Rnd) + 1) With Worksheets("Лист1") a = .Range("C" & R, "L" & R).Value End With
isExists = False For j = 1 To i If Arr(j, 11) = R Then isExists = True Next If Not isExists Then For k = 1 To UBound(a, 2) Arr(i, k) = a(1, k) Next Arr(i, 11) = R Else i = i - 1 End If Next End With Worksheets("Лист2").Range("A1").Resize(300, 10) = Arr Worksheets("Лист2").Activate End Sub
Sub qq() lr = Worksheets(1).Cells(Rows.Count, 3).End(xlUp).Row With CreateObject("Scripting.Dictionary") Do While .Count <= 300 k = Int((lr * Rnd + 1)) .Item(k) = Worksheets(1).Range("C" & k, "L" & k).Value Loop Worksheets("Лист2").Range("A1").Resize(300, 10) = _ Application.Transpose(Application.Transpose(.items)) Worksheets("Лист2").Activate End With End Sub
[/vba]
[vba]
Код
Sub qq() lr = Worksheets(1).Cells(Rows.Count, 3).End(xlUp).Row With CreateObject("Scripting.Dictionary") Do While .Count <= 300 k = Int((lr * Rnd + 1)) .Item(k) = Worksheets(1).Range("C" & k, "L" & k).Value Loop Worksheets("Лист2").Range("A1").Resize(300, 10) = _ Application.Transpose(Application.Transpose(.items)) Worksheets("Лист2").Activate End With End Sub
У меня получаются дублирующиеся строки (т.е. 2 строка, например 2 раза)
Да, когда писал макрос - отвлекли, и забыл про одну строчку. [vba]
Код
Sub djon2012() Dim i&, R&, a(), Arr(1 To 300, 1 To 11), k&, n& R = Worksheets("Лист1").Cells(Rows.Count, 3).End(xlUp).Row With New Collection For i = 1 To R .Add i Next For i = 1 To 300 Randomize R = Int((.Count * Rnd) + 1) n = .Item(R) ' вот эту строчку пропустил With Worksheets("Лист1") a = .Range("C" & n, "L" & n).Value End With For k = 1 To UBound(a, 2) Arr(i, k) = a(1, k) Next Arr(i, 11) = n .Remove (R) Next End With Worksheets("Лист2").Range("A1").Resize(300, 11) = Arr Worksheets("Лист2").Activate End Sub
У меня получаются дублирующиеся строки (т.е. 2 строка, например 2 раза)
Да, когда писал макрос - отвлекли, и забыл про одну строчку. [vba]
Код
Sub djon2012() Dim i&, R&, a(), Arr(1 To 300, 1 To 11), k&, n& R = Worksheets("Лист1").Cells(Rows.Count, 3).End(xlUp).Row With New Collection For i = 1 To R .Add i Next For i = 1 To 300 Randomize R = Int((.Count * Rnd) + 1) n = .Item(R) ' вот эту строчку пропустил With Worksheets("Лист1") a = .Range("C" & n, "L" & n).Value End With For k = 1 To UBound(a, 2) Arr(i, k) = a(1, k) Next Arr(i, 11) = n .Remove (R) Next End With Worksheets("Лист2").Range("A1").Resize(300, 11) = Arr Worksheets("Лист2").Activate End Sub
Michael, мне понравился ваш поход и как раз без лишних циклов, как лотырейные шарики вынимают из барабана, так и у вас потихоньку изымаются из рассмотрения и получается что каждый раз уникальный номер.
RAN приз за самый короткий код)) Не знала что в значения Dictionary можно записывать массивы значений. Я смотрю, что эти массивы просто так не выводятся почему то надо делать транспонирование транспонирования значений словаря. (Пробовала без транспонирований, ничего почему то не выводится, а с двумя транспортированиями выводится, почему так, для меня загадка)
Michael, мне понравился ваш поход и как раз без лишних циклов, как лотырейные шарики вынимают из барабана, так и у вас потихоньку изымаются из рассмотрения и получается что каждый раз уникальный номер.
RAN приз за самый короткий код)) Не знала что в значения Dictionary можно записывать массивы значений. Я смотрю, что эти массивы просто так не выводятся почему то надо делать транспонирование транспонирования значений словаря. (Пробовала без транспонирований, ничего почему то не выводится, а с двумя транспортированиями выводится, почему так, для меня загадка)Leanna
Лучше день потерять, потом за пять минут долететь!
A развернуть и посмотреть Arr слабо? Там одномерный массив массивов (кстати, оказывается ОО работает только с таким) Application.Transpose превращает его в двухмерный. Следующий Application.Transpose разворачивает полученный двухмерный массив.
A развернуть и посмотреть Arr слабо? Там одномерный массив массивов (кстати, оказывается ОО работает только с таким) Application.Transpose превращает его в двухмерный. Следующий Application.Transpose разворачивает полученный двухмерный массив.RAN
Конечно слабо Теперь всё ясно, спасибо RAN за ответы, ps (благодаря вашему сообщению я сегодня узнала про существование такого полезного окна как Locals)
Конечно слабо Теперь всё ясно, спасибо RAN за ответы, ps (благодаря вашему сообщению я сегодня узнала про существование такого полезного окна как Locals)Leanna
Лучше день потерять, потом за пять минут долететь!
День добрый! RAN спасибо за ваш вариант макроса. у меня к вам небольшой вопрос. Скажите пожалуйста в вашем варианте макроса идет проверка на дублирующиеся строки? Спасибо!
День добрый! RAN спасибо за ваш вариант макроса. у меня к вам небольшой вопрос. Скажите пожалуйста в вашем варианте макроса идет проверка на дублирующиеся строки? Спасибо!djon2012
Сообщение отредактировал djon2012 - Понедельник, 26.01.2015, 08:46
Данные из которых случайным образом извлекаются строки с значениями являются постоянными, их содержимое не изменяется. Макрос работает в цикле, генерируя новый набор строк с значениями. Меня интересует в вашем макросе (на примере ниже) если отобрана строка 2 с числом 87 есть ли возможность повторного отбора этой строки или макрос анализирует уже отобранные строки что бы исключить дубликаты. Меня интересует вывод строк с значениями без повторной дубликации за один цикл запуска макроса. Спасибо!!! 1) 5 2) 87 3) 96
Данные из которых случайным образом извлекаются строки с значениями являются постоянными, их содержимое не изменяется. Макрос работает в цикле, генерируя новый набор строк с значениями. Меня интересует в вашем макросе (на примере ниже) если отобрана строка 2 с числом 87 есть ли возможность повторного отбора этой строки или макрос анализирует уже отобранные строки что бы исключить дубликаты. Меня интересует вывод строк с значениями без повторной дубликации за один цикл запуска макроса. Спасибо!!! 1) 5 2) 87 3) 96djon2012