powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / удаление ячеек через VBA
10 сообщений из 10, страница 1 из 1
удаление ячеек через VBA
    #33819111
d_oshust
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Народ обращаюсь в очередной раз.
Такая просьба, в прикрепленном файле на Листе 2 типа БД поставщиков и покупателей. На листе 1 выбор их. Мне необходимо, когда я выбираю на Листе 1 покупателя или поставщика, и нажимаю соответствующую кнопку "Удалить" под ним удалялась ячейка с данным поставщиком или покупателем на листе2.
...
Рейтинг: 0 / 0
удаление ячеек через VBA
    #33819134
Фотография Ivan33
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: 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.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
Private Sub delcust_Click()
Application.ScreenUpdating = False
Dim custid As String
Dim ecustid As Variant
Dim ordsdel As Single
Dim ordercols As Integer
Dim ordrows As Single
Dim i As Integer
Dim c As Variant
Dim Response

custid = customer.Value

If custid <> "" Then
    custid = Left(custid, InStr( 1 , custid, ".") -  1 )
    
   
    
    Sheets("Customers").Select
    Range("A1").Select
    If ActiveCell.Offset( 1 ,  0 ).Text <> "" Then
        Range(ActiveCell.Offset( 1 ,  0 ), Selection.End(xlDown)).Select
    Else
        ActiveCell.Offset( 1 ,  0 ).Select
    End If
    
    For Each ecustid In Selection
        If ecustid = custid Then
            ecustid.Select
            Selection.EntireRow.delete
        End If
    Next
    
    If remcust.Value = True Then
    
        ordercols = Range("ordercols").Value
        Sheets("Orders").Select
        For i =  1  To ordercols
            
            Cells( 1 ,  4  + ((i -  1 ) *  12 )).Select
            If ActiveCell.Offset( 1 ,  0 ).Text <> "" Then
                
                ordsdel =  0 
                ActiveCell.Offset( 1 ,  0 ).Select
                Do Until ActiveCell.Text = ""

                    If ActiveCell.Value = custid Then
                        Range(ActiveCell.Offset( 0 , - 3 ), ActiveCell.Offset( 0 ,  8 )).delete Shift:=xlUp
                        ordsdel = ordsdel +  1 
                        Cells(ActiveCell.Row,  4  + ((i -  1 ) *  12 )).Select
                    Else
                        ActiveCell.Offset( 1 ,  0 ).Select
                    End If
                
                Loop
            
            End If
        
        Next
        
        If ordsdel =  1  Then
            Response = MsgBox("The customer ID " & custid & " was deleted and 1 order for this customer was also deleted.", vbInformation, "Customer Deleted")
        Else
            Response = MsgBox("The customer ID " & custid & " was deleted and " & ordsdel & " orders for this customer were also deleted.", vbInformation, "Customer Deleted")
        End If
    
    Else
    
        Response = MsgBox("The customer ID " & custid & " was deleted.", vbInformation, "Customer Deleted")
    
    End If
    
    customer.clear

    Sheets("Customers").Select
    Range("A1").Select
    Selection.CurrentRegion.Select
    Selection.Sort key1:=Range("B2"), Order1:=xlAscending, Header:= _
            xlGuess, OrderCustom:= 1 , MatchCase:=False, Orientation:=xlTopToBottom
    
    Range("A2").Select
    If ActiveCell.Offset( 1 ,  0 ).Text <> "" Then
        Range(Selection, Selection.End(xlDown)).Select
    End If
    
    For Each c In Selection
        If c.Text <> "" Then
            customer.AddItem (c.Value & ". " & c.Offset( 0 ,  1 ).Value & " (" & c.Offset( 0 ,  2 ).Value & ")")
        End If
    Next
    
    
    Sheets("Control").Select
End If

Application.ScreenUpdating = True
End Sub
...
Рейтинг: 0 / 0
удаление ячеек через VBA
    #33819162
d_oshust
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
я прошу прощения в VBA я далеко не силен, могу только на примере понять... данный код попробовал вкинуть в файл, но ничего у меня не вышло.. не могли бы Вы показать на моем файле как это сделать, БУДУ ОЧЕНЬ ПРИЗНАТЕЛЕН!!!
...
Рейтинг: 0 / 0
удаление ячеек через VBA
    #33819226
Фотография 100g
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
Sub DelPok()
    Dim Pok As String
    Dim Poks As Variant
    Dim i As Long, iCount As Long
    Poks = Range("Покупатель").Value
    Pok = Worksheets("Лист1").Range("H5").Value
    iCount = UBound(Poks)
    For i =  1  To iCount
        If Poks(i,  1 ) = Pok Then
            Worksheets("Лист2").Range("B" & i +  1 ).Delete Shift:=xlUp
            Exit For
        End If
    Next i
End Sub

М:)
...
Рейтинг: 0 / 0
удаление ячеек через VBA
    #33819390
d_oshust
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
У меня выдает ошибку в строке
Poks = Range("Покупатель").Value
...
Рейтинг: 0 / 0
удаление ячеек через VBA
    #33819526
Фотография 100g
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
d_oshustУ меня выдает ошибку в строке
Poks = Range("Покупатель").Value
А, ты наврно в код кнопки пишешь. Тогда укажи явно имя листа:
Код: plaintext
Poks = Worksheets("Лист2").Range("Покупатель").Value
...
Рейтинг: 0 / 0
удаление ячеек через VBA
    #33823989
d_oshust
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Спасибо ) работает :)
...
Рейтинг: 0 / 0
удаление ячеек через VBA
    #33824130
d_oshust
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
Это опять я и опять с вопросом в тему, если в данном случае мне необходимо удалить две рядом стоящие ячейки при выборе одной (покупатель и адрес)

Я попробовал так, но у меня не получилось:
Dim Pok As String
Dim Poks As Variant
Dim i As Long, iCount As Long
Poks = Worksheets("Справочник").Range("Покупатели").Value
Pok = Worksheets("уд пок").Range("B10").Value
iCount = UBound(Poks)
For i = 1 To iCount
If Poks(i, 1) = Pok Then
Worksheets("Справочник").Range("D:E" & i + 1).Delete Shift:=xlUp
Exit For
End If
Next i
тоесть я попробовал перед удалением выделить 2 ячейки, но vba ругается....видно так нельзя....
...
Рейтинг: 0 / 0
удаление ячеек через VBA
    #33824380
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
d_oshustЭто опять я и опять с вопросом в тему, если в данном случае мне необходимо удалить две рядом стоящие ячейки при выборе одной (покупатель и адрес)

Я попробовал так, но у меня не получилось:
Dim Pok As String
Dim Poks As Variant
Dim i As Long, iCount As Long
Poks = Worksheets("Справочник").Range("Покупатели").Value
Pok = Worksheets("уд пок").Range("B10").Value
iCount = UBound(Poks)
For i = 1 To iCount
If Poks(i, 1) = Pok Then
Worksheets("Справочник").Range("D:E" & i + 1).Delete Shift:=xlUp
Exit For
End If
Next i
тоесть я попробовал перед удалением выделить 2 ячейки, но vba ругается....видно так нельзя....
Код: plaintext
Worksheets("Справочник").Range("D" & i +  1  & ":E" & i +  1 ).Delete Shift:=xlUp
...
Рейтинг: 0 / 0
удаление ячеек через VBA
    #33824392
d_oshust
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Гость
СПАСИБО!!!!!!!! :))
...
Рейтинг: 0 / 0
10 сообщений из 10, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / удаление ячеек через VBA
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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