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


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