Добрый вечер, уважаемые коллеги. Перечитав смежные с моей темы, решений не обнаружил, теперь вынужден обратиться к вам. На работе потребовали написать макрос на vba для подсчёта совпадений чисел в таблице. В общем, есть готовая форма excel 2010, которую я прикрепляю, в которой даны 2 таблицы: tbM (10000x300) и tbQ (10000x2). Требуется автозаполнение таблицы tbM случайными числами от 1 до 10000, а затем автоматически заполнить столбец "Количество совпадений" в tbQ - сколько раз число n (значение в столбце "Число") встречается в tbM. Операция должна выполнятся по кнопке и по окончании работы макроса программа пишет затраченное время на сию операцию. Как вставить этот секундомер в автофигуру, которая у меня на форме, я совсем не понимаю, второй день разбираюсь в vba, тяжеловато. Требуется ваша помощь в доработке кода, буду крайне признателен, если ткнёте в ошибки, хотя, их может и нет. Вставляю свой код на кнопку: [vba]
Код
Sub Procedure() a = Timer Dim rRange As Excel.Range Dim rCell As Excel.Range Set rRange = Range("E4:KQ10003") For Each rCell In rRange.Cells rCell.Value = Int(Rnd * 10000 + 1) Next rCell Dim i As Integer Dim j As Integer Dim iRowNumber As Integer Dim jStrNumber As Integer Dim s As Integer Dim p As Integer p = 0 s = 1 iRowNumber = 0 jStrNumber = 0 Set rRange = Range("B4:B10003") For s = 1 To 100 For i = 1 To 300 For j = 1 To 10000 If Cells(i, j).Value = text Then p = p + 1 iRowNumber = i jStrNumber = j rCell.Value = p Exit For End If Next j Next i Next s TextBox1.text = Format(Timer - a) End Sub
[/vba] Это последняя версия моих "трудов", очень долго обрабатывает мой комп этот макрос, иногда вовсе зависает. Экселевская форма весит около 3мб, поэтому сомневаюсь, что смогу её сюда загрузить, на всякий случай оставлю скриншот формы, о которой шла речь: Очень нужны ваши советы и помощь. Заранее благодарен. P.S. Залил саму форму на обменник: ФОРМА
Добрый вечер, уважаемые коллеги. Перечитав смежные с моей темы, решений не обнаружил, теперь вынужден обратиться к вам. На работе потребовали написать макрос на vba для подсчёта совпадений чисел в таблице. В общем, есть готовая форма excel 2010, которую я прикрепляю, в которой даны 2 таблицы: tbM (10000x300) и tbQ (10000x2). Требуется автозаполнение таблицы tbM случайными числами от 1 до 10000, а затем автоматически заполнить столбец "Количество совпадений" в tbQ - сколько раз число n (значение в столбце "Число") встречается в tbM. Операция должна выполнятся по кнопке и по окончании работы макроса программа пишет затраченное время на сию операцию. Как вставить этот секундомер в автофигуру, которая у меня на форме, я совсем не понимаю, второй день разбираюсь в vba, тяжеловато. Требуется ваша помощь в доработке кода, буду крайне признателен, если ткнёте в ошибки, хотя, их может и нет. Вставляю свой код на кнопку: [vba]
Код
Sub Procedure() a = Timer Dim rRange As Excel.Range Dim rCell As Excel.Range Set rRange = Range("E4:KQ10003") For Each rCell In rRange.Cells rCell.Value = Int(Rnd * 10000 + 1) Next rCell Dim i As Integer Dim j As Integer Dim iRowNumber As Integer Dim jStrNumber As Integer Dim s As Integer Dim p As Integer p = 0 s = 1 iRowNumber = 0 jStrNumber = 0 Set rRange = Range("B4:B10003") For s = 1 To 100 For i = 1 To 300 For j = 1 To 10000 If Cells(i, j).Value = text Then p = p + 1 iRowNumber = i jStrNumber = j rCell.Value = p Exit For End If Next j Next i Next s TextBox1.text = Format(Timer - a) End Sub
[/vba] Это последняя версия моих "трудов", очень долго обрабатывает мой комп этот макрос, иногда вовсе зависает. Экселевская форма весит около 3мб, поэтому сомневаюсь, что смогу её сюда загрузить, на всякий случай оставлю скриншот формы, о которой шла речь: Очень нужны ваши советы и помощь. Заранее благодарен. P.S. Залил саму форму на обменник: ФОРМАzealot
Сообщение отредактировал zealot - Понедельник, 30.10.2017, 23:51
Оптимизированный и рабочий макрос, который мне подсказали форумчане. Время работы - 10 сек. [vba]
Код
Sub tbMtotbQ() Dim ard&(1 To 10000, 1 To 300), arr&(1 To 10000, 1 To 2), r&, c&, tm As Single Randomize: tm = Timer For r = 1 To 10000 arr(r, 1) = r For c = 1 To 300 ard(r, c) = 1 + Int(Rnd * 10000): arr(ard(r, c), 2) = arr(ard(r, c), 2) + 1 Next Next Cells(4, 1).Resize(10000, 2).Value = arr Cells(4, 5).Resize(10000, 299).Value = ard Cells(1, 8).Value = Timer - tm MsgBox "сделано за " & Timer - tm & " сек." End Sub
[/vba]
Оптимизированный и рабочий макрос, который мне подсказали форумчане. Время работы - 10 сек. [vba]
Код
Sub tbMtotbQ() Dim ard&(1 To 10000, 1 To 300), arr&(1 To 10000, 1 To 2), r&, c&, tm As Single Randomize: tm = Timer For r = 1 To 10000 arr(r, 1) = r For c = 1 To 300 ard(r, c) = 1 + Int(Rnd * 10000): arr(ard(r, c), 2) = arr(ard(r, c), 2) + 1 Next Next Cells(4, 1).Resize(10000, 2).Value = arr Cells(4, 5).Resize(10000, 299).Value = ard Cells(1, 8).Value = Timer - tm MsgBox "сделано за " & Timer - tm & " сек." End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
