powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / VBA-(EXCEL)-Макрос
16 сообщений из 41, страница 2 из 2
VBA-(EXCEL)-Макрос
    #33223331
Ды правильно And, сорри за ошибку.
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33223373
Фотография OreL
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
OreL infantНу например:
Public Sub VSEPereschetPrice()
Dim lngCounter As Long, dblTemp As Double

If vbCancel = MsgBox("..............", _
vbQuestion + vbOKCancel, "....") Then Exit Sub

lngCounter = 0

Do While ActiveCell.Offset(lngCounter, 0).Value <> Empty
dblTemp = ActiveCell.Offset(lngCounter, 0).Value

If dblTemp <= 1 Then
ActiveCell.Offset(lngCounter, 0).Value = dblTemp + (dblTemp * 2)
ElseIf dblTemp > 1 And dblTemp <= 5 Then
ActiveCell.Offset(lngCounter, 0).Value = dblTemp + (dblTemp * 1.75)
..........................
ElseIf dblTemp > 100 Then
ActiveCell.Offset(lngCounter, 0).Value = dblTemp + (dblTemp * 1.4)
End If

lngCounter = lngCounter + 1

Loop
End Sub
Не активируя каждый раз каждую след. ячейки вы при больших списках избавляетесь от обновления изображения каждый раз. (можно св-во application.screenupdating использовать - но обработчик ошибок не забудьте тогда)



Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
Public Sub MoskvarechieBrend()
Dim lngCounter As Long, dblTemp As Long
If vbCancel = MsgBox("Âû óñòàíîâèëè êóðñîð íà íà÷àëî ïðîâåðÿìîãî ñòîëáöà?", _
vbQuestion + vbOKCancel, "Âîïðîñ") Then Exit Sub

lngCounter =  0 

Do While ActiveCell.Offset(lngCounter,  0 ).Value <> Empty
dblTemp = ActiveCell.Offset(lngCounter,  0 ).Value

If dblTemp <> "555" Or dblTemp <> "AKG" Or dblTemp <> "BENDIX" Or _
dblTemp <> "BENDIX" Or dblTemp <> "BERU" Or dblTemp <> "BOGE" Or _
dblTemp <> "BOSAL" Or dblTemp <> "BOSCH" Or dblTemp <> "BREMBO" Or _
dblTemp <> "CTC" Or dblTemp <> "FEBI" Or dblTemp <> "FILTRON" Or _
dblTemp <> "GATES" Or dblTemp <> "GKN" Or dblTemp <> "GMB" Or _
dblTemp <> "GRAF" Or dblTemp <> "HANS PRIES" Or dblTemp <> "LUK" Or _
dblTemp <> "IRB" Or dblTemp <> "JURD" Or dblTemp <> "KAYABA" Or _
dblTemp <> "KNECHT" Or dblTemp <> "LEMFORDER" Or dblTemp <> "LESJOFORS" Or _
dblTemp <> "LPR" Or dblTemp <> "MANN" Or dblTemp <> "NGK" Or _
dblTemp <> "NISSENS" Or dblTemp <> "MANN" Or dblTemp <> "SACHS" Or _
dblTemp <> "SKF" Or dblTemp <> "SNR" Or dblTemp <> "VDO" Or _
dblTemp <> "VERNET" Or dblTemp <> "VICTOR REINZ" Or _
dblTemp <> "ZF" Then
   

Selection.EntireRow.Delete

Else

lngCounter = lngCounter +  1 

End If
Loop
End Sub


Что здесь не так ?


Понял !
Неправильно обьявлена переменная dblTemp
надо dblTemp As String.
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33224986
Фотография OreL
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Подскажите пожалуйста где тут ошибка !?!
Этот макрос должен удалять все строки кроме представленных в условии If

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
Sub sssss()
Dim lngCounter As Long
Dim dblTemp As String


lngCounter =  0 

Do While ActiveCell.Offset(lngCounter,  0 ).Value <> Empty
dblTemp = ActiveCell.Offset(lngCounter,  0 ).Value

If dblTemp <> "555" And dblTemp <> "AKG" And dblTemp <> "BENDIX" And _
dblTemp <> "BENDIX" And dblTemp <> "BERU" And dblTemp <> "BOGE" And _
dblTemp <> "BOSAL" And dblTemp <> "BOSCH" And dblTemp <> "BREMBO" And _
dblTemp <> "CTC" And dblTemp <> "FEBI" And dblTemp <> "FILTRON" And _
dblTemp <> "GATES" And dblTemp <> "GKN" And dblTemp <> "GMB" And _
dblTemp <> "GRAF" And dblTemp <> "HANS PRIES" And dblTemp <> "LUK" And _
dblTemp <> "IRB" And dblTemp <> "JURD" And dblTemp <> "KAYABA" And _
dblTemp <> "KNECHT" And dblTemp <> "LEMFAndDER" And dblTemp <> "LESJOFAndS" And _
dblTemp <> "LPR" And dblTemp <> "MANN" And dblTemp <> "NGK" And _
dblTemp <> "NISSENS" And dblTemp <> "MANN" And dblTemp <> "SACHS" And _
dblTemp <> "SKF" And dblTemp <> "SNR" And dblTemp <> "VDO" And _
dblTemp <> "VERNET" And dblTemp <> "VICTAnd REINZ" And _
dblTemp <> "ZF" Then
   

Selection.Offset.EntireRow.Delete

 Else

lngCounter = lngCounter +  1 

End If
Loop
End Sub
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33225119
sergeyvg
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Работа с ActiveCell, а удаление Selection. В Selection может быть несколько строк и ты их, вместо одной строки, все убьешь.
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33225147
Фотография OreL
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
sergeyvgРабота с ActiveCell, а удаление Selection. В Selection может быть несколько строк и ты их, вместо одной строки, все убьешь.

У меня вообще ничего не удаляется,
просто идёт перебор всех строк в медленном темпе и всё !
Почему ?
я не понимаю !
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33225155
infant
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Потому что у вас всегда активна только самая первая ячейка. На другие вы ссылаетесь по смещению, но не переходя на них и получается что вы всегда удаляете самую первую строку. Замените Selection.Offset.EntireRow.Delete
на ActiveCell.Offset(lngCounter).EntireRow.Delete
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33225171
Фотография OreL
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
infantПотому что у вас всегда активна только самая первая ячейка. На другие вы ссылаетесь по смещению, но не переходя на них и получается что вы всегда удаляете самую первую строку. Замените Selection.Offset.EntireRow.Delete
на ActiveCell.Offset(lngCounter).EntireRow.Delete

Понял спасибо, но обновление экрана всёравно происходит !
Почему ?
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33225194
Фотография OreL
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
2 infant

А где можно почитать о Макросах в EXCEL ?
Можно ссылочку если есть ?
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33225201
infant
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Потому что строки удаляются. Нижние сдвиг. вверх и excel это отрисовывает.
Попробйте:
Sub sssss()
Dim lngCounter As Long
Dim dblTemp As String

On Error GoTo ErrHand

Application.ScreenUpdating = False
lngCounter = 0
........................

Loop ' заканчивается ваш loop

Application.ScreenUpdating = True
Exit Sub
ErrHand:
Application.ScreenUpdating = True
MsgBox Err.Number & vbCrLf & Err.Description, vbCritical + vbOKOnly, "Îøèáêà!"

End Sub
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33225204
infant
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
OreL2 infant

А где можно почитать о Макросах в EXCEL ?
Можно ссылочку если есть ?

К сожалению нет ссылок :-(((( У меня давно-давно была книжка :-) Ну а остальное все F1 :-)
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33225217
Фотография OreL
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
infant OreL2 infant

А где можно почитать о Макросах в EXCEL ?
Можно ссылочку если есть ?

К сожалению нет ссылок :-(((( У меня давно-давно была книжка :-) Ну а остальное все F1 :-)

Спасибо понял !
Тогда у меня последний на сегодня вопрос если можно !?
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33225228
Фотография OreL
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Есть столбец:

123
456
789
321

как его превратить в:

img-123.ftp
img-456.ftp
img-789.ftp
img-321.ftp

с помощью макроса ?
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33225259
Код: plaintext
1.
2.
3.
4.
5.
6.
    Dim rng As Range
    
    For Each rng In Range("A:A")
        If Not (IsEmpty(rng.Value)) Then
            rng.Value = "img-" & rng.Value & ".ftp"
        End If
    Next
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33225804
Фотография OreL
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Пользователь2
Код: plaintext
1.
2.
3.
4.
5.
6.
    Dim rng As Range
    
    For Each rng In Range("A:A")
        If Not (IsEmpty(rng.Value)) Then
            rng.Value = "img-" & rng.Value & ".ftp"
        End If
    Next


Этот код заполняет весь столбец от 1 до 65000 ячейки,
а надо до первой пустой !!!!
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33225864
Фотография OreL
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Пользователь2
Код: plaintext
1.
2.
3.
4.
5.
6.
    Dim rng As Range
    
    For Each rng In Range("A:A")
        If Not (IsEmpty(rng.Value)) Then
            rng.Value = "img-" & rng.Value & ".ftp"
        End If
    Next



Спасибо, надо просто кое чего добавить суда.


Пользователь2
Код: plaintext
1.
2.
3.
4.
5.
6.
    Dim rng As Range
    
    For Each rng In Range("A:A")
        If Not (IsEmpty(rng.Value)) AND  rng.Value <> Empty Then
            rng.Value = "img-" & rng.Value & ".ftp"
        End If
    Next


Вот так работает до первой пустой ячейки !
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33225872
infant
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Добавить в if
Else
Exit For
...
Рейтинг: 0 / 0
16 сообщений из 41, страница 2 из 2
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / VBA-(EXCEL)-Макрос
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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