Страницы: 1
RSS
Раскрытие диапазона данных на странице
 
Здравствуйте, гуру Екселя.  
Возникает иногда такая необходимость в обработке диапазона данных... Хотелось бы как то это воплотить в удобную форму макроса, который можно было бы запускать кнопкой.  
Представляется это так. Нажимается кнопка, появляется окно с возможностью введения двух цифр - диапазонов номеров("от" и "до"). Например: 2000000-2500000  
Сами цифры могут быть от 5 до 12 значными. Но меняются обычно последнии 3-7 цифр.    
И вот, при нажатии "Старт" или "Ок" начинается заполнение столбцов чистого листа с  ячейки A1 и вниз цифрами от 2000000 до 2500000. В каждом столбце не более 50000 цифр. Т.е. в итоге получаем на листе столбец A состоит из цифр с 2000000 до 2049999, столбец B с 2050000 до 2099999 и т.д пока на последнем столбце не останется цифра 2500000.  
Файл прикладывать не стал - вроде все понятно написал, но если потребуется - выложу.  
 
Заранее благодарен.
 
Вот ваш макрос - проверяйте:  
 
Sub ЗаполнениеТаблицыЧислами()  
   txt = InputBox("Введите 2 числа в формате XXXX-YYYYYY")  
   If Not txt Like "#*#-#*#" Then MsgBox "Введена строка, не распознанная как диапазон чисел": Exit Sub  
     
   v1 = Val(Split(txt, "-")(0)): v2 = Val(Split(txt, "-")(1))  
   dv = Abs(v2 - v1)    ' количество значений  
   cc = dv \ 50000 + 1    ' количество столбцов  
   rc = IIf(dv > 50000, 50000, dv)    ' количество строк  
     
   ReDim arr(1 To rc, 1 To cc)  
   ' заполнение массива  
   For i = v1 To v2 Step Sgn(v2 - v1)  
       arr(n Mod 50000 + 1, n \ 50000 + 1) = i: n = n + 1  
   Next i  
 
   msg = "Сформирован массив размерами " & UBound(arr, 1) & " на " & UBound(arr, 2) & _  
         vbNewLine & "Записать массив на лист Excel?"  
   If MsgBox(msg, vbQuestion + vbOKCancel) = vbCancel Then Exit Sub  
     
   ' перенос массива на новый лист Excel  
   Worksheets.Add.Cells(1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr  
End Sub  
 
 
Пример в виде файла: http://excelvba.ru/XL_Files/Sample__26-12-2011__12-37-50.zip
 
Простите, но он не работает.  
Файл разъархивировал, запустил. Нажал кнопку, ввожу диапазоны, например 10000-10009 или любой другой.  
Выходит окно с ошибкой: "Subscript out of range"
 
У меня всё работает:  
http://ExcelVBA.ru/pictures/20111226-720-42kb.jpg  
 
Когда макрос только написал - тестировал на разных диапазонах, всё чётко и быстро отрабатывало.  
Когда вы написали, что не работает, - стал проверять, - и действительно, выскакивает эта ошибка, при разных наборах чесел.  
Поскольку причин для появления этой ошибки нет, стал искать её источник в пошаговом режиме (F8), - и, о чудо, ошибка исчезла. (ни одной буквы в коде не менял)  
 
 
Проверьте ещё раз - тот же макрос, только в другом файле:  
http://excelvba.ru/XL_Files/Sample__26-12-2011__18-25-45.zip
 
Да, действительно, этот файл теперь работает. :-))  
Спасибо большое. Сейчас погоняю еще с разными диапазонами.
Страницы: 1
Читают тему
Наверх