привет, у меня возникли некоторые проблемы с кодированием VBA в Excel. У меня есть список рассылки, в котором есть строки для каждого человека, однако есть много людей, которые находятся в тех же домохозяйствах, что и другой человек. у обоих одинаковые адреса и совпадающий идентификатор домохозяйства. Мне нужно объединить имена людей с одним и тем же идентификатором и адресом домохозяйства, чтобы MS Word мог сделать почтовые ярлыки для каждого дома.
Код должен найти строки с одинаковым идентификатором домохозяйства, Приветствие, Описание запроса, Улица 1, Улица 2, Улица 3, Город, Штат, Почтовый индекс. и объедините текст в верхней и нижней строке с символом «&» для имени почты, квасцов Y / N, доноров Y / N, Solicitable. Где результат - информация о верхних строках до & и нижняя строка после. Все данные уже отсортированы, поэтому дубликаты идентификаторов домохозяйств находятся вместе. Я не очень много кодирую и не пользуюсь многими соглашениями об именах. Я собрал это на некоторых форумах. Я получаю сообщение об ошибке с ключевым разделом. Примеры изображений Excel прилагаются, надеюсь, их можно просмотреть. Любая помощь приветствуется. Спасибо :)
Sub merge_A_to_D_data()
Dim rw As Long, lr As Long, str As String, dbl As Double
Application.ScreenUpdating = False
With ActiveSheet.Cells(1, 1).CurrentRegion
.Cells.Sort Key1:=.Columns(2), Order1:=xlAscending, _
Key2:=.Columns(4), Order2:=xlAscending, _
Key3:=.Columns(5), Order3:=xlAscending, _
Key4:=.Columns(6), Order4:=xlAscending, _
Key5:=.Columns(7), Order5:=xlAscending, _
Key6:=.Columns(8), Order6:=xlAscending, _
Key7:=.Columns(9), Order7:=xlAscending, _
Key8:=.Columns(10), Order8:=xlAscending, _
Key9:=.Columns(11), Order9:=xlAscending, _
Key10:=.Columns(12), Order10:=xlAscending, _
Key11:=.Columns(13), Order11:=xlAscending, _
Key12:=.Columns(14), Order12:=xlAscending, _
Key13:=.Columns(15), Order13:=xlAscending, _
Orientation:=xlTopToBottom, Header:=xlYes
lr = .Rows.Count
For rw = .Rows.Count To 2 Step -1
If .Cells(rw, 2).Value2 <> .Cells(rw - 1, 2).Value2 And _
.Cells(rw, 4).Value2 <> .Cells(rw - 1, 4).Value2 And _
.Cells(rw, 5).Value2 <> .Cells(rw - 1, 5).Value2 And _
.Cells(rw, 6).Value2 <> .Cells(rw - 1, 6).Value2 And _
.Cells(rw, 7).Value2 <> .Cells(rw - 1, 7).Value2 And _
.Cells(rw, 8).Value2 <> .Cells(rw - 1, 8).Value2 And _
.Cells(rw, 9).Value2 <> .Cells(rw - 1, 9).Value2 And _
.Cells(rw, 10).Value2 <> .Cells(rw - 1, 10).Value2 And _
.Cells(rw, 11).Value2 <> .Cells(rw - 1, 11).Value2 And _
.Cells(rw, 12).Value2 <> .Cells(rw - 1, 12).Value2 And _
.Cells(rw, 13).Value2 <> .Cells(rw - 1, 13).Value2 And _
.Cells(rw, 14).Value2 <> .Cells(rw - 1, 14).Value2 And _
.Cells(rw, 15).Value2 <> .Cells(rw - 1, 15).Value2 And rw < lr Then
.Cells(rw, 3) = Join(Application.Transpose(.Range(.Cells(rw, 3), .Cells(lr, 3))), Chr(59))
.Cells(rw + 1, 1).Resize(lr - rw, 1).EntireRow.Delete
lr = rw - 1
End If
Next rw
End With
Application.ScreenUpdating = True
End Sub
до запуска кода, рис.
после запуска кода, рис.