Доброго всем времени суток и настроения! Уважаемые форумчане и знатоки, прошу помощи! Есть некая база данных, информация которая сортирована по колоннам А,В,С,D,Е (прилагается excel файл/sheet 1,2). В прикрепленном файле есть макрос который автоматически удаляет повторяющюйся вбитую информацию в колонну D. Но тут есть одна проблема. Этот макрос работает когда имена по одному вбивается в Excel. Когда копируешь и вставляешь группу людей (допустим из 10 человек) из другого файла (People counting-2 копируем только колонну Card number) то Excel выдает ошибку Run-time error 13 Type mismatch. Можно ли как небудь решить эту проблему? Что бы когда вставляешь копированную из 10 человек информацию Excel находил обе одинаковые значения и удалял как он делает это по одному. Заранее благодарен.
Доброго всем времени суток и настроения! Уважаемые форумчане и знатоки, прошу помощи! Есть некая база данных, информация которая сортирована по колоннам А,В,С,D,Е (прилагается excel файл/sheet 1,2). В прикрепленном файле есть макрос который автоматически удаляет повторяющюйся вбитую информацию в колонну D. Но тут есть одна проблема. Этот макрос работает когда имена по одному вбивается в Excel. Когда копируешь и вставляешь группу людей (допустим из 10 человек) из другого файла (People counting-2 копируем только колонну Card number) то Excel выдает ошибку Run-time error 13 Type mismatch. Можно ли как небудь решить эту проблему? Что бы когда вставляешь копированную из 10 человек информацию Excel находил обе одинаковые значения и удалял как он делает это по одному. Заранее благодарен.Fiko81
Здравствуйте. Так подойдёт? Предполагается, что строки добавляются в конец столбца [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim irow&, cl As Range, rowsDel As Range If Target.Column <> 4 Then Exit Sub For Each cl In Target For irow = 2 To Target.Row - 1 If cl.Value = Cells(irow, 4) Then If rowsDel Is Nothing Then Set rowsDel = Union(Rows(irow), Rows(cl.Row)) Else Set rowsDel = Union(rowsDel, Rows(irow), Rows(cl.Row)) Exit For End If Next irow Next cl If Not rowsDel Is Nothing Then rowsDel.Delete End Sub
[/vba]
Здравствуйте. Так подойдёт? Предполагается, что строки добавляются в конец столбца [vba]
Код
Private Sub Worksheet_Change(ByVal Target As Range) Dim irow&, cl As Range, rowsDel As Range If Target.Column <> 4 Then Exit Sub For Each cl In Target For irow = 2 To Target.Row - 1 If cl.Value = Cells(irow, 4) Then If rowsDel Is Nothing Then Set rowsDel = Union(Rows(irow), Rows(cl.Row)) Else Set rowsDel = Union(rowsDel, Rows(irow), Rows(cl.Row)) Exit For End If Next irow Next cl If Not rowsDel Is Nothing Then rowsDel.Delete End Sub