Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / VBA-(EXCEL)-Макрос / 25 сообщений из 41, страница 1 из 2
15.08.2005, 16:53:52
    #33216137
OreL
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VBA-(EXCEL)-Макрос
Есть таблица:
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
15.08.2005, 17:23:48
    #33216208
Processor
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VBA-(EXCEL)-Макрос
OreLКак с помощью макроса удалить все строки, где значение столбца А="Сидоров"См. Help-->AutoFilter method и пример к нему OreLи что б все нижние строки заняли места удалённых ???
После фильтрации удали видимые строки.
...
Рейтинг: 0 / 0
15.08.2005, 17:35:07
    #33216238
OreL
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VBA-(EXCEL)-Макрос
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
15.08.2005, 17:44:05
    #33216264
infant
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VBA-(EXCEL)-Макрос
Ставим курсор на начало столбца с фамилиями и:

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
15.08.2005, 17:55:46
    #33216287
OreL
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VBA-(EXCEL)-Макрос
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
15.08.2005, 19:50:02
    #33216459
infant
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VBA-(EXCEL)-Макрос
Извините пожалуйста, конечно я ошибся (писал просто на память и сначала хотел немного другой вариант). Надо не If ActiveCell.Offset(i, 0) = "Сидоров" Then - a правильно в данном варианте Do While ActiveCell.Value <> Empty (проверка ячейки которую мы сделали активной) и объявление переменной i и ее инициализация конечно совсем не нужны :-))
...
Рейтинг: 0 / 0
16.08.2005, 11:48:55
    #33217434
OreL
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VBA-(EXCEL)-Макрос
infantИзвините пожалуйста, конечно я ошибся (писал просто на память и сначала хотел немного другой вариант). Надо не If ActiveCell.Offset(i, 0) = "Сидоров" Then - a правильно в данном варианте Do While ActiveCell.Value <> Empty (проверка ячейки которую мы сделали активной) и объявление переменной i и ее инициализация конечно совсем не нужны :-))

Если не трудно можно работающий код написать ?
...
Рейтинг: 0 / 0
16.08.2005, 12:06:37
    #33217520
infant
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VBA-(EXCEL)-Макрос
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
16.08.2005, 12:24:59
    #33217614
OreL
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VBA-(EXCEL)-Макрос
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
16.08.2005, 12:34:15
    #33217666
infant
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VBA-(EXCEL)-Макрос
Не совсем. Вот так вставьте
If ActiveCell.Value = "Сидоров" or _
ActiveCell.Value = "Иванов" or _
ActiveCell.Value = "Петров" Then
...
Рейтинг: 0 / 0
16.08.2005, 12:47:26
    #33217728
OreL
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VBA-(EXCEL)-Макрос
infantНе совсем. Вот так вставьте
If ActiveCell.Value = "Сидоров" or _
ActiveCell.Value = "Иванов" or _
ActiveCell.Value = "Петров" Then

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

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

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

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

Спасибо всё заработало.
Забыл пробел поставить "Or_" "Or _"
...
Рейтинг: 0 / 0
17.08.2005, 12:58:26
    #33220320
OreL
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VBA-(EXCEL)-Макрос
Где тут ошибка?
не понимаю почему 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
17.08.2005, 13:15:07
    #33220398
infant
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VBA-(EXCEL)-Макрос
Потому что в 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
17.08.2005, 13:38:38
    #33220508
OreL
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VBA-(EXCEL)-Макрос
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
17.08.2005, 14:11:50
    #33220628
infant
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VBA-(EXCEL)-Макрос
Ну например:
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
17.08.2005, 17:30:21
    #33221482
OreL
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VBA-(EXCEL)-Макрос
Cпасибо буду пробывать.
...
Рейтинг: 0 / 0
18.08.2005, 12:40:11
    #33222832
OreL
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VBA-(EXCEL)-Макрос
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
18.08.2005, 12:45:44
    #33222859
VBA-(EXCEL)-Макрос
Код: plaintext
1.
2.
If ActiveCell.Value <> "Сидоров" Or _
  ActiveCell.Value <> "Иванов" Then
    Selection.EntireRow.Delete
...
Рейтинг: 0 / 0
18.08.2005, 13:38:25
    #33223051
OreL
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VBA-(EXCEL)-Макрос
Пользователь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
18.08.2005, 14:39:11
    #33223221
OreL
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VBA-(EXCEL)-Макрос
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
18.08.2005, 14:40:26
    #33223227
Eugene Mailov
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VBA-(EXCEL)-Макрос
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
18.08.2005, 15:10:08
    #33223325
OreL
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
VBA-(EXCEL)-Макрос
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
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / VBA-(EXCEL)-Макрос / 25 сообщений из 41, страница 1 из 2
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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