powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / VBA-(EXCEL)-Макрос
41 сообщений из 41, показаны все 2 страниц
VBA-(EXCEL)-Макрос
    #33216137
Фотография OreL
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Есть таблица:
A B C D E
Иванов 5 100 1000 xxx
Иванов 5 100 1000 xxxxxx
Иванов 5 100 1000 xx
Иванов 5 100 1000 x
Иванов 5 100 1000 xxx
Сидоров 6 120 1200 xx
Сидоров 6 120 1200 x
Сидоров 6 120 1200 xxxxxx
Сидоров 6 120 1200 xx
Сидоров 6 120 1200 xxx
Петров 7 125 1250 xxxxxx
Петров 7 125 1250 xx
Петров 7 125 1250 x
Петров 7 125 1250 xxxxxxxx
Петров 7 125 1250 x
Петров 7 125 1250 xxx

Как с помощью макроса удалить все строки, где значение столбца А="Сидоров", и что б все нижние строки заняли места удалённых ???
выход:

A B C D E
Иванов 5 100 1000 xxx
Иванов 5 100 1000 xxxxxx
Иванов 5 100 1000 xx
Иванов 5 100 1000 x
Иванов 5 100 1000 xxx
Петров 7 125 1250 xxxxxx
Петров 7 125 1250 xx
Петров 7 125 1250 x
Петров 7 125 1250 xxxxxxxx
Петров 7 125 1250 x
Петров 7 125 1250 xxx



Заранее благодарен.
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33216208
Processor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
OreLКак с помощью макроса удалить все строки, где значение столбца А="Сидоров"См. Help-->AutoFilter method и пример к нему OreLи что б все нижние строки заняли места удалённых ???
После фильтрации удали видимые строки.
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33216238
Фотография OreL
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Processor OreLКак с помощью макроса удалить все строки, где значение столбца А="Сидоров"См. Help-->AutoFilter method и пример к нему OreLи что б все нижние строки заняли места удалённых ???
После фильтрации удали видимые строки.

Автофильтр:

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
Sub ssss()

    Selection.AutoFilter Field:= 1 , Criteria1:="Сидоров"
    Rows("7:11").Select
    Range("A11").Activate
    Selection.Delete Shift:=xlUp
    
End Sub

А если без автофильтра ?
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33216264
infant
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Ставим курсор на начало столбца с фамилиями и:

Dim i As Integer

i = 0
Do While ActiveCell.Value <> Empty ' пербтираем все фамилии до первой пустой ячейки
If ActiveCell.Offset(i, 0) = "Сидоров" Then
' если искомая фамилия -удаляем строку
Selection.EntireRow.Delete
Else ' иначе просто переходим на след. запись
ActiveCell.Offset(1, 0).Activate
End If

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

Dim i As Integer

i = 0
Do While ActiveCell.Value <> Empty ' пербтираем все фамилии до первой пустой ячейки
If ActiveCell.Offset(i, 0) = "Сидоров" Then
' если искомая фамилия -удаляем строку
Selection.EntireRow.Delete
Else ' иначе просто переходим на след. запись
ActiveCell.Offset(1, 0).Activate
End If

Loop

Спасибо.
Попробую на практике.
О результате обязательно сообщю завтра !
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33216459
infant
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Извините пожалуйста, конечно я ошибся (писал просто на память и сначала хотел немного другой вариант). Надо не If ActiveCell.Offset(i, 0) = "Сидоров" Then - a правильно в данном варианте Do While ActiveCell.Value <> Empty (проверка ячейки которую мы сделали активной) и объявление переменной i и ее инициализация конечно совсем не нужны :-))
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33217434
Фотография OreL
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
infantИзвините пожалуйста, конечно я ошибся (писал просто на память и сначала хотел немного другой вариант). Надо не If ActiveCell.Offset(i, 0) = "Сидоров" Then - a правильно в данном варианте Do While ActiveCell.Value <> Empty (проверка ячейки которую мы сделали активной) и объявление переменной i и ее инициализация конечно совсем не нужны :-))

Если не трудно можно работающий код написать ?
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33217520
infant
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Option Explicit

Public Sub test()
If vbCancel = MsgBox("Вы установили курсор на начало проверямого столбца?", _
vbQuestion + vbOKCancel, "Вопрос") Then Exit Sub

Do While ActiveCell.Value <> Empty
' Перебираем все фамилии до первой пустой чейки
If ActiveCell.Value = "Сидоров" Then
' если Сидоров - удаляем строку
Selection.EntireRow.Delete
Else ' если нет - переходим на другую строку
ActiveCell.Offset(1, 0).Activate
End If
Loop
End Sub
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33217614
Фотография OreL
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
infantOption Explicit

Public Sub test()
If vbCancel = MsgBox("Вы установили курсор на начало проверямого столбца?", _
vbQuestion + vbOKCancel, "Вопрос") Then Exit Sub

Do While ActiveCell.Value <> Empty
' Перебираем все фамилии до первой пустой чейки
If ActiveCell.Value = "Сидоров" Then
' если Сидоров - удаляем строку
Selection.EntireRow.Delete
Else ' если нет - переходим на другую строку
ActiveCell.Offset(1, 0).Activate
End If
Loop
End Sub

Спасибо огромное всё работает.
А если мне надо удалить сразу три фамилии

Код: plaintext
If ActiveCell.Value = "Сидоров" and "Иванов" and "Петров" Then

так будет верно ?
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33217666
infant
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Не совсем. Вот так вставьте
If ActiveCell.Value = "Сидоров" or _
ActiveCell.Value = "Иванов" or _
ActiveCell.Value = "Петров" Then
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33217728
Фотография OreL
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
infantНе совсем. Вот так вставьте
If ActiveCell.Value = "Сидоров" or _
ActiveCell.Value = "Иванов" or _
ActiveCell.Value = "Петров" Then

Так тоже не хочет работать !
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33217741
Фотография OreL
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
OreL infantНе совсем. Вот так вставьте
If ActiveCell.Value = "Сидоров" or _
ActiveCell.Value = "Иванов" or _
ActiveCell.Value = "Петров" Then

Так тоже не хочет работать !

Выдаёт ошибку:

Compile error:
Expected: end of statement.
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33217788
В коде End If забыл поставить.
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33217797
Фотография OreL
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
infantНе совсем. Вот так вставьте
If ActiveCell.Value = "Сидоров" or _
ActiveCell.Value = "Иванов" or _
ActiveCell.Value = "Петров" Then

Спасибо всё заработало.
Забыл пробел поставить "Or_" "Or _"
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33220320
Фотография OreL
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Где тут ошибка?
не понимаю почему Loop не работает !

Код: 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.
Public Sub VSEPereschetPrice()
If vbCancel = MsgBox("Вы установили курсор на начало проверяемого столбца?", _
vbQuestion + vbOKCancel, "Вопрос") Then Exit Sub

Do While ActiveCell.Value <> Empty

If ActiveCell.Value <=  1  Then
ActiveCell.Value = ActiveCell.Value + (ActiveCell.Value *  2 )
If ActiveCell.Value >  1  And ActiveCell.Value <=  5  Then
ActiveCell.Value = ActiveCell.Value + (ActiveCell.Value *  1 . 75 )
If ActiveCell.Value >  5  And ActiveCell.Value <=  10  Then
ActiveCell.Value = ActiveCell.Value + (ActiveCell.Value *  1 . 55 )
If ActiveCell.Value >  10  And ActiveCell.Value <=  50  Then
ActiveCell.Value = ActiveCell.Value + (ActiveCell.Value *  1 . 4 )
If ActiveCell.Value >  50  And ActiveCell.Value <=  80  Then
ActiveCell.Value = ActiveCell.Value + (ActiveCell.Value *  1 . 3 )
If ActiveCell.Value >  80  And ActiveCell.Value <=  90  Then
ActiveCell.Value = ActiveCell.Value + (ActiveCell.Value *  1 . 27 )
If ActiveCell.Value >  90  And ActiveCell.Value <=  100  Then
ActiveCell.Value = ActiveCell.Value + (ActiveCell.Value *  1 . 22 )
If ActiveCell.Value >  100  Then
ActiveCell.Value = ActiveCell.Value + (ActiveCell.Value *  1 . 18 )

Else
ActiveCell.Offset( 1 ,  0 ).Activate
End If
Loop
End Sub
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33220398
infant
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Потому что в else не попадаете :-)

Если вам надо весь столбец просмотреть:

Do While ActiveCell.Value <> Empty
.........
If ActiveCell.Value <= 1 Then
ActiveCell.Value = ActiveCell.Value + (ActiveCell.Value * 2)
ElseIf ActiveCell.Value > 1 And ActiveCell.Value <= 5 Then
ActiveCell.Value = ActiveCell.Value + (ActiveCell.Value * 1.75)
ElseIf ActiveCell.Value > 5 And ActiveCell.Value <= 10 Then
..........
end if
ActiveCell.Offset(1, 0).Activate
Loop
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33220508
Фотография OreL
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
infantПотому что в else не попадаете :-)

Если вам надо весь столбец просмотреть:

Do While ActiveCell.Value <> Empty
.........
If ActiveCell.Value <= 1 Then
ActiveCell.Value = ActiveCell.Value + (ActiveCell.Value * 2)
ElseIf ActiveCell.Value > 1 And ActiveCell.Value <= 5 Then
ActiveCell.Value = ActiveCell.Value + (ActiveCell.Value * 1.75)
ElseIf ActiveCell.Value > 5 And ActiveCell.Value <= 10 Then
..........
end if
ActiveCell.Offset(1, 0).Activate
Loop

Cпасибо огромное, так всё работает как часы.
А есть возможность ускорить процесс ???
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33220628
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 использовать - но обработчик ошибок не забудьте тогда)
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33221482
Фотография OreL
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Cпасибо буду пробывать.
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33222832
Фотография OreL
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
infantOption Explicit

Public Sub test()
If vbCancel = MsgBox("Вы установили курсор на начало проверямого столбца?", _
vbQuestion + vbOKCancel, "Вопрос") Then Exit Sub

Do While ActiveCell.Value <> Empty
' Перебираем все фамилии до первой пустой чейки
If ActiveCell.Value = "Сидоров" Then
' если Сидоров - удаляем строку
Selection.EntireRow.Delete
Else ' если нет - переходим на другую строку
ActiveCell.Offset(1, 0).Activate
End If
Loop
End Sub

А если мне надо оставить только "Иванова" и "Сидорова", а "Петрова" и остальных удалить,
как это будет выглядеть ???
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33222859
Код: plaintext
1.
2.
If ActiveCell.Value <> "Сидоров" Or _
  ActiveCell.Value <> "Иванов" Then
    Selection.EntireRow.Delete
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33223051
Фотография OreL
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Пользователь2
Код: plaintext
1.
2.
If ActiveCell.Value <> "Сидоров" Or _
  ActiveCell.Value <> "Иванов" Then
    Selection.EntireRow.Delete


Спасибо.


Как можно это ускорить уж больно медленно работает ?

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
Do While ActiveCell.Value <> Empty

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

Selection.EntireRow.Delete
Else 
ActiveCell.Offset( 1 ,  0 ).Activate
End If
Loop
End Sub
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33223221
Фотография 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


Что здесь не так ?
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33223227
Eugene Mailov
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
OreL
А если мне надо оставить только "Иванова" и "Сидорова", а "Петрова" и остальных удалить,
как это будет выглядеть ???
Пользователь2
Код: plaintext
1.
2.
If ActiveCell.Value <> "Сидоров" Or _
  ActiveCell.Value <> "Иванов" Then
    Selection.EntireRow.Delete


вообще-то
If ActiveCell.Value <> "Сидоров" And _
ActiveCell.Value <> "Иванов" Then
Selection.EntireRow.Delete
...
Рейтинг: 0 / 0
VBA-(EXCEL)-Макрос
    #33223325
Фотография OreL
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Eugene Mailov OreL
А если мне надо оставить только "Иванова" и "Сидорова", а "Петрова" и остальных удалить,
как это будет выглядеть ???
Пользователь2
Код: plaintext
1.
2.
If ActiveCell.Value <> "Сидоров" Or _
  ActiveCell.Value <> "Иванов" Then
    Selection.EntireRow.Delete


вообще-то
If ActiveCell.Value <> "Сидоров" And _
ActiveCell.Value <> "Иванов" Then
Selection.EntireRow.Delete

А в чём разница ???
...
Рейтинг: 0 / 0
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
41 сообщений из 41, показаны все 2 страниц
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / VBA-(EXCEL)-Макрос
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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