Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Как разделить диапазон на 1000 в VBA?
 
#1
05.01.2008 13:40:43
на листе я просто создаю ячейку с значением 1000, копирую ее, выделяю диапазон, спецвставка - разделить  
Но мне кажется некрасивым вариант тех же действий в VBA.  
Нет ли возможности умножить/разделить/сложить каждую ячейку диапазона на одно и тоже число без последовательного перебора всех ячееек?
 
 
 
#2
05.01.2008 14:09:16
{quote}{login=Лузер}{date=05.01.2008 01:40}{thema=Как разделить диапазон на 1000 в VBA?}{post}на листе я просто создаю ячейку с значением 1000, копирую ее, выделяю диапазон, спецвставка - разделить  
Но мне кажется некрасивым вариант тех же действий в VBA.  
Нет ли возможности умножить/разделить/сложить каждую ячейку диапазона на одно и тоже число без последовательного перебора всех ячееек?{/post}{/quote}  
Я бы не беспокоился о некрасивости этого метода... при больших количествах ячеек этот метод будет значительно быстрее всех остальных. Если отключать обновление экрана, то для пользователя вставка 1000 в какую-нибудь свободную ячейку будет вообщен незаметной.    
 
Но если хотите компромисс, то присвойте область ячеек масссиву (очень быстрая операция), обработайте значения массива по циклу (довольно быстро), и верните массив обратно на лист.
 
 
 
#3
05.01.2008 14:33:29
Пожалуй воткну ячейку на постоянной основе.  
Ибо беру я с одного листа значения в кВт и вставляю на другой лист, но уже в МВт надо. А хватаю я сразу по 744 ячейки 26 раз. Не хочется 26х744 циклов гонять.  
спс за совет
 
 
 
#4
05.01.2008 17:20:36
А почему нельзя на втором листе в нужных ячейках прописать формулу деления на 1000? Если эта операция производится многократно, и Вы хотите получить в ячейках значения, то можно из второго листа сделать копию в книге.  И там, выделив все ячейки в листе, двумя кнопками (копировать и вставить значения) проблема решается.  
С уважением, Александр.
 
 
 
#5
05.01.2008 17:54:58
У меня эта книга только с данными. Никаких формул. Она и так под 70 метров. И ручная работа в этой книге исключена - дорого обходится, только макросами.  
В общем делю диапазон на ячейку с тыщей - быстрей всего
 
 
 
#6
20.07.2010 18:17:15
{quote}{login=Лузер}{date=05.01.2008 01:40}{thema=Как разделить диапазон на 1000 в VBA?}{post}на листе я просто создаю ячейку с значением 1000, копирую ее, выделяю диапазон, спецвставка - разделить  
Но мне кажется некрасивым вариант тех же действий в VBA.  
Нет ли возможности умножить/разделить/сложить каждую ячейку диапазона на одно и тоже число без последовательного перебора всех ячееек?{/post}{/quote}  
 
Так же интересен данный вопрос, только немного по другому  
так же надо все разделить на 1000, но перед этим (или после) скопировать все значениями. Т.е. в ячейках формулы, надо диапазон, который я выделю, разделить на 1000 и оставить все значениями, без формул.  
Хочется такой мини макросик :) я бы его прикрепил к кнопочке и жал на нее, когда надо разделить на 1000 :-D. С макросами к сожалению на "вы"..  
Спасибо за помощь!
 
 
 
#7
20.07.2010 18:28:10
Sub Very_Difficult_Macro()  
With Selection  
.Value = .Value  
[C100].Copy
.PasteSpecial xlPasteAll, xlDivide  
End With  
End Sub  
 
В ячейке C100 - Ваше значение, на которое необходимо разделить.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#8
20.07.2010 22:44:21
{quote}{login=The_Prist}{date=20.07.2010 06:28}{thema=}{post}Sub Very_Difficult_Macro()  
With Selection  
.Value = .Value  
[C100].Copy
.PasteSpecial xlPasteAll, xlDivide  
End With  
End Sub  
 
В ячейке C100 - Ваше значение, на которое необходимо разделить.{/post}{/quote}  
 
Спасибо!  
P.S. Very_Difficult_Macro() - тут грамотно подъе... :-D  
Ну не разбираюсь я) но все равно спасибо))
 
 
 
#9
21.07.2010 08:07:28
Я извиняюсь, но все-таки не совсем то, что нужно  
Так пойдет, если все делается в одном листе  
А я этим пользуюсь постоянно.  
Как забить, чтобы он не копировал из ячейки "C100", а принудительно всегда делил на 1000, без копирований откуда-то.
 
 
 
#10
21.07.2010 09:48:29
{quote}{login=Kekstron}{date=21.07.2010 08:07}{thema=}{post}  
Так пойдет, если все делается в одном листе{/post}{/quote}Как вопрос был задан - такой ответ был получен. Вы ж не писали, что на всех листах надо да еще и не вводя ничего...Тогда так:  
 
Sub Very_Difficult_Macro_2()  
If TypeName(Selection) <> "Range" Then  
MsgBox "Выделенная область не является диапазоном", vbCritical, "Hay from The_Prist": Exit Sub  
End If  
   Dim li As Long, le As Long, avArr()  
   With Selection  
       avArr = .Value  
       For le = 1 To .Columns.Count  
           For li = LBound(avArr) To UBound(avArr)  
               If Len(avArr(li, le)) > 0 Then  
                   If IsNumeric(avArr(li, le)) Then  
                       avArr(li, le) = avArr(li, le) / 1000  
                   End If  
               End If  
           Next li  
       Next le  
       .Value = avArr  
   End With  
End Sub
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#11
21.07.2010 09:56:42
{quote}{login=The_Prist}{date=21.07.2010 09:48}{thema=Re: }{post}{quote}{login=Kekstron}{date=21.07.2010 08:07}{thema=}{post}  
Так пойдет, если все делается в одном листе{/post}{/quote}Как вопрос был задан - такой ответ был получен. Вы ж не писали, что на всех листах надо да еще и не вводя ничего...Тогда так:  
 
Sub Very_Difficult_Macro_2()  
If TypeName(Selection) <> "Range" Then  
MsgBox "Выделенная область не является диапазоном", vbCritical, "Hay from The_Prist": Exit Sub  
End If  
   Dim li As Long, le As Long, avArr()  
   With Selection  
       avArr = .Value  
       For le = 1 To .Columns.Count  
           For li = LBound(avArr) To UBound(avArr)  
               If Len(avArr(li, le)) > 0 Then  
                   If IsNumeric(avArr(li, le)) Then  
                       avArr(li, le) = avArr(li, le) / 1000  
                   End If  
               End If  
           Next li  
       Next le  
       .Value = avArr  
   End With  
End Sub{/post}{/quote}  
 
Спасибо! Работает, но с косячком))  
если веделить больше одной ячейки, то все "чики-пуки", а вот отдельно взятую ячейку не делит, выдает ошибку "Run-time error '13': Type mismatch"
 
 
 
#12
21.07.2010 10:03:32
Отдельно взятую могли бы и ручками разделить :-) Зачем тут макрос?  
 
Sub Very_Difficult_Macro_2()  
   If TypeName(Selection) <> "Range" Then  
       MsgBox "Выделенная область не является диапазоном", vbCritical, "Hay from The_Prist": Exit Sub  
   End If  
   Dim li As Long, le As Long, lCount As Long, avArr()  
   With Selection  
       lCount = .Count  
       If lCount > 1 Then  
           avArr = .Value  
       Else  
           ReDim avArr(1, 1): avArr(1, 1) = .Value  
       End If  
       For le = 1 To .Columns.Count  
           For li = LBound(avArr) To UBound(avArr)  
               If Len(avArr(li, le)) > 0 Then  
                   If IsNumeric(avArr(li, le)) Then  
                       avArr(li, le) = avArr(li, le) / 1000  
                   End If  
               End If  
           Next li  
       Next le  
       If lCount > 1 Then  
           .Value = avArr  
       Else: .Value = avArr(1, 1)  
       End If  
   End With  
End Sub
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
 
 
#13
21.07.2010 10:43:41
предложу свои 2 копейки:  
Sub t()  
Dim a()  
On Error GoTo er  
With Selection  
a = .Value  
Dim li As Long, le As Long  
For le = 1 To UBound(a, 2)  
For li = 1 To UBound(a)  
If Len(a(li, le)) Then  
If IsNumeric(a(li, le)) Then  
a(li, le) = a(li, le) / 1000  
End If  
End If  
Next li  
Next le  
.Value = a  
End With  
Exit Sub  
er: ReDim a(1 To 1, 1 To 1)  
   a(1, 1) = Selection  
   Resume Next  
End Sub  
 
Sub t2()  
With Selection  
If .Count > 1 Then  
.Value = .Value / 1000  
Else  
Dim li As Long, le As Long, a  
a = .Value  
For le = 1 To UBound(a, 2)  
For li = 1 To UBound(a)  
If Len(a(li, le)) Then  
If IsNumeric(a(li, le)) Then  
a(li, le) = a(li, le) / 1000  
End If  
End If  
Next li  
Next le  
.Value = a  
End With  
Exit Sub  
End Sub
Живи и дай жить..
 
 
 
#14
21.07.2010 10:51:31
слэн, не проверяли? Вроде так надо в.2 (2 ошибки):  
 
Sub t2()  
With Selection  
   If .Count = 1 Then  
   .Value = .Value / 1000  
   Else  
   Dim li As Long, le As Long, a  
   a = .Value  
       For le = 1 To UBound(a, 2)  
           For li = 1 To UBound(a)  
               If Len(a(li, le)) Then  
                   If IsNumeric(a(li, le)) Then  
                   a(li, le) = a(li, le) / 1000  
                   End If  
               End If  
           Next li  
       Next le  
   .Value = a  
   End If  
   End With  
Exit Sub  
End Sub
 
 
 
#15
21.07.2010 12:29:37
Спасибо!  
Все прекрасно работает.  
Повысили мою ПТ :)))
 
 
 
#16
18.08.2010 11:44:17
{quote}{login=слэн}{date=21.07.2010 10:43}{thema=}{post}предложу свои 2 копейки:  
Sub t()  
Dim a()  
On Error GoTo er  
With Selection  
a = .Value  
Dim li As Long, le As Long  
For le = 1 To UBound(a, 2)  
For li = 1 To UBound(a)  
If Len(a(li, le)) Then  
If IsNumeric(a(li, le)) Then  
a(li, le) = a(li, le) / 1000  
End If  
End If  
Next li  
Next le  
.Value = a  
End With  
Exit Sub  
er: ReDim a(1 To 1, 1 To 1)  
   a(1, 1) = Selection  
   Resume Next  
End Sub  
{/post}{/quote}  
 
Я извиняюсь за назойливость, но можно еще как-то сделать отмену этого действия, если вдруг случайно нажал? :-[
и для чего нужно Sub t2() я так и не понял...) t1() отдельно отлично работает)  
Спасибо)
 
 
 
#17
18.08.2010 12:00:37
{quote}{login=Kekstron}{date=18.08.2010 11:44}{thema=Re: }{post}и для чего нужно Sub t2() я так и не понял...) t1() отдельно отлично работает)  
Спасибо){/post}{/quote}Так ведь демократия. Что б свобода выбора была ;)
 
 
 
#18
18.08.2010 13:08:02
Ответ на давно заданный Лузером вопрос:  
 
[A1:C21] = [A1:C21/1000]
[A1:C21] = Evaluate("A1:C21/1000")
KL
 
 
 
Страницы: 1
Читают тему
Наверх