powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Сменить знак
15 сообщений из 15, страница 1 из 1
Сменить знак
    #34432194
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Подскажите как сменить знак при заполнении одного диапазона из другого диапазона
что-то типа этого хотел написать, но вероятно это глупость!

Код: plaintext
Range1.Value = - Range2.Value
...
Рейтинг: 0 / 0
Сменить знак
    #34432256
vbapro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
почему же глупость?!
...
Рейтинг: 0 / 0
Сменить знак
    #34432296
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
vbaproпочему же глупость?!
потому что не получается! Имеется ввиду, что диапазоны одинаковые, но диапазоны, а не одна ячейка, т.е.

towb.Sheets(1).Range(Cells(x,y).Address, Cells(x+1,y+2).Address).Value = _
- fromwb.Sheets(2).Range(Cells(x,y).Address, Cells(x+1,y+2).Address).Value
...
Рейтинг: 0 / 0
Сменить знак
    #34432319
vbapro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
KL написал бы что-нибудь вроде этого :):
Код: plaintext
[F168:F174] = [G168:G174*- 1 ]
...
Рейтинг: 0 / 0
Сменить знак
    #34432351
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
vbaproKL написал бы что-нибудь вроде этого :):
Код: plaintext
[F168:F174] = [G168:G174*- 1 ]

Так не получится, на другую книгу ссылается
...
Рейтинг: 0 / 0
Сменить знак
    #34432369
vbapro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
так попробуй:
Код: plaintext
1.
towb.Sheets( 1 ).Range(Cells(x, y).Address, Cells(x +  1 , y +  2 ).Address).FormulaArray = _
fromwb.Sheets( 2 ).Range(Cells(x, y).Address, Cells(x +  1 , y +  2 ).Address).FormulaArray * - 1 
...
Рейтинг: 0 / 0
Сменить знак
    #34432405
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
vbaproтак попробуй:
Код: plaintext
1.
towb.Sheets( 1 ).Range(Cells(x, y).Address, Cells(x +  1 , y +  2 ).Address).FormulaArray = _
fromwb.Sheets( 2 ).Range(Cells(x, y).Address, Cells(x +  1 , y +  2 ).Address).FormulaArray * - 1 

Полтергейст какой-то оставляет пустые ячейки и ошибки не выдаёт
...
Рейтинг: 0 / 0
Сменить знак
    #34432423
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Сейчас наверное уйду и не смогу быть на связи, а решить желательно, поэтому прошу оставлять свои предложения несмотря на то, что я не буду отвечать!
Заранее спасибо!
...
Рейтинг: 0 / 0
Сменить знак
    #34432426
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Я через цикл по ячейкам в диапазоне сделал, но там несколько тысяч ячеек, очень долго получается! Хочется побыстрее, даже не хочется, а нужно.
...
Рейтинг: 0 / 0
Сменить знак
    #34432435
vbapro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
DeggasadЯ через цикл по ячейкам в диапазоне сделал, но там несколько тысяч ячеек, очень долго получается! Хочется побыстрее, даже не хочется, а нужно.можно формулами массива, а цикл я тоже попробовал:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
Sub test()
Dim r1 As Range
Dim r2 As Range
Dim i As Long
Set r1 = towb.Sheets( 1 ).Range(Cells(x, y).Address, Cells(x +  1 , y +  2 ).Address)
Set r2 = fromwb.Sheets( 2 ).Range(Cells(x, y).Address, Cells(x +  1 , y +  2 ).Address)

    If r1.Count = r2.Count Then
        For i =  1  To r1.Count
            r2(i).Value = r1(i).Value * - 1 
        Next i
    End If
    
    Set r1 = Nothing
    Set r2 = Nothing

End Sub
...
Рейтинг: 0 / 0
Сменить знак
    #34432507
Volder
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
DeggasadПодскажите как сменить знак при заполнении одного диапазона из другого диапазона


можно так
есть диапазон со значениями - выделяешь диапазон такой же длины
в адресе формулы вводишь "=-"
затем выделяешь весь диапазон, у которого хочешь сменить знак
нажимаешь Ctrl+Shift+Enter
в формуле отобразиться формула у всего диапазона "{=-первая_ячека_дипазона:последняя_ячейка_диапазона}"
смотри атач
...
Рейтинг: 0 / 0
Сменить знак
    #34432528
lena_####
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Deggasad

У меня такой вариант работает (Excel 2002) (обе книги открыты)
Код: plaintext
[[ 02 .xls]Sheet1!A1:A10000] = [[ 01 .xls]Sheet1!A1:A10000*- 1 ]
...
Рейтинг: 0 / 0
Сменить знак
    #34432544
vbapro
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
vbapro DeggasadЯ через цикл по ячейкам в диапазоне сделал, но там несколько тысяч ячеек, очень долго получается! Хочется побыстрее, даже не хочется, а нужно.можно формулами массива, а цикл я тоже попробовал:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
Sub test()
Dim r1 As Range
Dim r2 As Range
Dim i As Long
Set r1 = towb.Sheets( 1 ).Range(Cells(x, y).Address, Cells(x +  1 , y +  2 ).Address)
Set r2 = fromwb.Sheets( 2 ).Range(Cells(x, y).Address, Cells(x +  1 , y +  2 ).Address)

    If r1.Count = r2.Count Then
        For i =  1  To r1.Count
            r2(i).Value = r1(i).Value * - 1 
        Next i
    End If
    
    Set r1 = Nothing
    Set r2 = Nothing

End Sub
вот еще вариант
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
Sub test(x As Long, y As Long)
Dim EvStr1 As String
Dim EvStr2 As String

    EvStr1 = Cells(x, y).Address(RowAbsolute:=False, ColumnAbsolute:=False) _
        & ":" & Cells(x +  1 , y +  1 ).Address(RowAbsolute:=False, ColumnAbsolute:=False)

    EvStr2 = Cells(x, y).Address(RowAbsolute:=False, ColumnAbsolute:=False) _
        & ":" & Cells(x +  1 , y +  1 ).Address(RowAbsolute:=False, ColumnAbsolute:=False) & "*-1"

    towb.Sheets( 1 ).Evaluate(EvStr1) = fromwb.Sheets( 2 ).Evaluate(EvStr2)
End Sub
...
Рейтинг: 0 / 0
Сменить знак
    #34432669
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Спасибовсем большое

lena_####
У меня такой вариант работает (Excel 2002) (обе книги открыты)
Код: plaintext
[[ 02 .xls]Sheet1!A1:A10000] = [[ 01 .xls]Sheet1!A1:A10000*- 1 ]


Что так можно я понял, и как раз думал спросить нет чего-нибуть наподобие функции ДВССЫЛ в VBA? , vbapro в самую точку подсказал метод Evaluate

получается
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
 
   EvStr1 = "'[" & towb.Name & "]" & Sheets( 1 ).Name & "'!" & Cells(x, y).Address(False, False) _
        & ":" & Cells(x +  5000 , y +  10 ).Address(False, False)

    EvStr2 = "'[" & fromwb.Name & "]" & Sheets( 2 ).Name & "'!" & Cells(x, y).Address(False, False) _
        & ":" & Cells(x +  5000 , y +  10 ).Address(False, False) & "*-1"
   
    Evaluate(EvStr1) = Evaluate(EvStr2)
равнозначно
Код: plaintext
 [[Книга1.xls]Лист1!A1:K5001] = [[Книга2.xls]Лист2!A1:K5001*- 1 ]

Volder твой совет тоже интересный, я этой возможноси не знал

и ещё вот сам придумал, но пользоваться наверное не буду, просто как вариант

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
    towb.Sheets( 1 ).Range(Cells(x, y).Address, Cells(x +  5000 , y +  10 ).Address).Value = _
    fromwb.Sheets( 2 ).Range(Cells(x, y).Address, Cells(x +  5000 , y +  10 ).Address).Value
    With towb.Sheets( 1 )
    Dim n As Variant, m As Variant
     .Cells( 1 ,  12 ).Formula = "-1"
     .Cells( 1 ,  12 ).Copy
     .Range(Cells(x, y), Cells(x +  5000 , y +  10 )).Select
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlMultiply
     .Cells( 1 ,  12 ).Clear
    End With
...
Рейтинг: 0 / 0
Сменить знак
    #34445950
KL (XL)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Я бы сделал так:

Код: plaintext
1.
2.
3.
4.
5.
6.
Sub test()
    Dim rng As Range
    With Workbooks("Книга1.xls").Sheets("Лист1")
        Set rng = .Range(.Cells( 1 , "A"), .Cells(.Rows.Count, "A").End(xlUp))
    End With
    ActiveSheet.Range("A1").Resize(rng.Count) = Evaluate("-" & rng.Address(, , , True))
End Sub


KL
[MVP - Microsoft Excel]
...
Рейтинг: 0 / 0
15 сообщений из 15, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Сменить знак
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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