求好人心帮帮忙-利用户主身份证调取家庭成员信息

dequang

VBA在表sheet1中同一户主下的家庭成员数据不一定要集中在一起，可以在表最后随时添加记录！
服务器又上传不了图片和附件了
Sub chaxun()
    Dim arr, hh, k%, j%
    Set d1 = CreateObject("Scripting.Dictionary")  '字典d1计算户主家庭人口数
    Set d2 = CreateObject("Scripting.Dictionary")  '字典d2放户主家庭每个成员所在的行号

    '清除表格家庭成员原有数据
    Sheets("低保户").Range("a9:f17").ClearContents

    maxrow = Sheets("sheet1").Range("b" & Rows.Count).End(xlUp).Row
    arr = Sheets("sheet1").Range("a2:ah" & maxrow)
    For i = 1 To maxrow - 1
        d1(arr(i, 13)) = d1(arr(i, 13)) + 1
        d2(arr(i, 13)) = d2(arr(i, 13)) & "," & i
    Next
    sfz = Sheets("低保户").Range("F3")
    hh = d2(sfz)
    hh = Split(hh, ",")
    j = 0
    For i = 1 To UBound(hh)
        k = hh(i)
        If arr(k, 11) = "本人" Then
            With Sheets("低保户")
                .[B3] = arr(k, 12)  '户主姓名
                .[D3] = arr(k, 9)   '户主性别
                .[D4] = UBound(hh)  '家庭人口数
                .[F4] = arr(k, 10)  '是否建档立卡对象
                .[B5] = arr(k, 18)  '健康状况
                .[D5] = arr(k, 6)   '保障金额(元)
                .[F5] = arr(k, 26)  '起始保障年月
                .[B6] = arr(k, 29)  '居住地址
                .[F6] = arr(k, 30)  '联系电话
            End With
        Else
            With Sheets("低保户")
                .Range("A" & 9 + j) = arr(k, 2)    '户主家庭成员姓名
                .Range("B" & 9 + j) = arr(k, 11)   '与户主关系
                .Range("C" & 9 + j) = arr(k, 9)    '性别
                .Range("D" & 9 + j) = arr(k, 17)   '年龄
                .Range("E" & 9 + j) = arr(k, 34)   '出生年月
                j = j + 1
            End With
        End If
    Next
End Sub