Решил этот и другие свои вопросы, может не так изящно, как хотелось. Но тем не менее работает. Надеюсь кому-то поможет. Я решил делать в 2 приёма: сначала на дополнительный лист переносится что мне надо, а потом вносится в шаблон.
Код |
---|
Sub UniqueAgents()
'
Dim Delimeter As String, i As Long
Delimeter = ", " 'символы-разделители (можно заменить на пробел или ; и т.д.)
Sheets("Лист1").Select
Columns("C:C").Select
Selection.Copy
Sheets("Лист2").Select
Columns("A:A").Select
ActiveSheet.Paste
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Columns("A:A").Select
ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
Range("A1").Select
i = 1
Do While Not IsEmpty(Cells(i, 1))
r = 1
'создаём и копируем переменные
Dog = "" 'номер договора
SData = "" 'дата начала
EData = "" 'дата окончания
Kurator = "" 'куратор
DKurator = "" 'должность куратора
Many = "0" 'собрано
Izmena = ""
Do While Not IsEmpty(Sheets("Лист1").Cells(r, 3))
If Sheets("Лист2").Cells(i, 1) = Sheets("Лист1").Cells(r, 3) Then
Dog = Dog & Sheets("Лист1").Cells(r, 1).Value & Delimeter
SData = Sheets("Лист1").Cells(r, 7).Value
EData = Sheets("Лист1").Cells(r, 8).Value
Kurator = Sheets("Лист1").Cells(r, 15).Value
DKurator = Sheets("Лист1").Cells(r, 16).Value
Many = Many + Sheets("Лист1").Cells(r, 21).Value
If Sheets("Лист1").Cells(r, 18).Text Like "*ФЗ*" Then Izmena = "" Else: Izmena = "Изменения в учредительные документы не вносились."
r = r + 1
Else: r = r + 1
End If
Loop
'вставляем переменные
Cells(i, 2) = Left(Dog, Len(Dog) - Len(Delimeter))
Cells(i, 3) = SData
Cells(i, 4) = EData
Cells(i, 5) = DKurator
Cells(i, 6) = Kurator
Cells(i, 7) = Izmena
Cells(i, 8) = Many
i = i + 1
Loop
End Sub
|
В word шаблоне добавил окно для вставки переменной и туда уже добавлял из 7й ячейки 2го листа.