户主成员合并成竖列

9667466

gwjkkkkk 发表于 2023-3-28 17:58
请参考附件。。。

大师  如果名字和证件号在别的列我要修改应该改哪里呢
Sub test()
    Dim ar, br$(), i&, j&, r&
   
    ar = [A1].CurrentRegion
    ReDim br(1 To UBound(ar) * UBound(ar, 2), 1 To 2)
    For i = 2 To UBound(ar)
        r = r + 1
        br(r, 1) = ar(i, 6): br(r, 2) = ar(i, 7)
        For j = 15 To UBound(ar, 2) Step 2
            If ar(i, j) <> "" Then
            r = r + 1
            br(r, 1) = ar(i, j): br(r, 2) = ar(i, j + 1)
            End If
        Next j
    Next i
   
    With Sheets(2)
        .Cells.Clear
        .[A1].Resize(r, 2) = br
        .Activate
    End With
    Beep
End Sub

9667466

破例 发表于 2023-3-28 19:34
参与一下~~~~

你这个发现个问题 所有证件号带X的合并不了

吴中泉

9667466 发表于 2023-4-24 12:19
大师  如果名字和证件号在别的列我要修改应该改哪里呢
Sub test()
    Dim ar, br$(), i&, j&, r&

增加了表头位置识别功能,不用改代码就可以增减列,详见附件内说明和代码
多行数据合并到一列.zip (19.11 KB, 下载次数: 7)

2023-4-25 13:04 上传

点击文件名下载附件