将数据透视表中的字段合并到准备邮件合并

Question

我正在准备一个邮件合并，以通知实体感兴趣的地方有地址变更。我提取所有信息并在Excel中使用它。问题是，数据和一些电子邮件有多个实体。我附上了一个例子。

是否有将电子邮件和相应实体放在彼此相邻的单元格中？ （每组共2个细胞）

即。从
到。

Answer 1

试试这个：

Sub Sum()
Dim i As Integer, j As Integer, size As Integer, Bound As Integer: size = 0
Dim lRow As Long
Dim sht As Worksheet
Dim arr() As Variant, arr2() As Variant
Dim data As String

Set sht = Worksheets("Sheet1") 'Adjust

lRow = sht.Cells(sht.Rows.Count, 2).End(xlUp).Row

For i = 1 To lRow
    If sht.Cells(i, 1).Value <> "" Then
        ReDim Preserve arr(size)
        arr(size) = i
        size = size + 1
    End If
Next
arr2 = sht.Range("A1:B" & lRow)
sht.Range("A1:B" & lRow).Columns.Clear
For i = 0 To UBound(arr)
    If i + 1 > UBound(arr) Then
        Bound = lRow
    Else
        Bound = arr(i + 1) - 1
    End If
    For j = arr(i) To Bound
        If j = Bound Then
            data = data & arr2(j, 2)
        Else
            data = data & arr2(j, 2) & vbNewLine
        End If
    Next j
    sht.Cells(i + 1, 1).Value = arr2(arr(i), 1)
    sht.Cells(i + 1, 2).Value = data
    data = ""
Next i
End Sub

输入：

输出：

所以它的基本原理是，我通过Col A获取电子邮件的行。然后它将数据存储在一个数组中并删除列的内容。最后它将通过数组（它使用第一个数组获取第二个数组的索引）并给出所需的格式。