调试了一下。现在变成提示：“下标越界”。

Sub 提取多字段不重复数据()
    Dim i&, j%, k&, arr, brr, crr
    Dim d As Object
    Set d = CreateObject("scripting.dictionary")
    Dim wb
    wb = ThisWorkbook.Path & "\安邦人寿-银保-2018.1.1-4.11.xlsm"
    arr = wb.Sheets(4).Range("A2:P" & Sheets(4).Cells(Rows.Count, 1).End(xlUp).Row)
    For i = 1 To UBound(arr)
        'If arr(i, 5) <> "" Then(可加入条件)
        d(arr(i, 1) & "-" & arr(i, 4) & "-" & arr(i, 7)) = ""
    Next
    brr = Application.Transpose(d.keys)
    ReDim crr(1 To UBound(brr), 1 To 3)
    For k = 1 To d.Count
        crr(k, 1) = Split(brr(k, 1), "-")(0)
        crr(k, 2) = Split(brr(k, 1), "-")(1)
        crr(k, 3) = Split(brr(k, 1), "-")(2)
    Next
    Sheet3.Range("A2").Resize(UBound(crr), 3) = crr
End Sub