原始数据表中是采集上来的数据，能否根据原始数据，利用VBA复制成 上报模板的样子

cby0318

原始数据表中是采集上来的数据，能否根据原始数据，利用VBA复制成 上报模板的样子。如：张三后面有4位共同居住人，那就把张三及张三的身份证号码两列以及4位共同居住人相关信息，依次粘贴到上报模板中。其他人员依次向下粘贴。（如果能实现有重名的可能分辨出来做好）

cby0318

哪位大神能帮助一些

一执成念

自己写个循环就好了，重名问题，用身份证号码肯定不会重复

smsn

没电脑,帮你顶一下.
原始数据读取到数组。
共2列+3列+3列+3列+3列
遍历行，改为
2列+3列
2列+3列
2列+3列
2列+3列
应该行

蓝桥玄霜

统计的例子：

gwjkkkkk

Sub TEST()
    Dim arr, vData, i&, j&, R&, dic As Object
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
    arr = Sheets(1).[A1].CurrentRegion ': R = 1
    [A1].CurrentRegion.Offset(1).Clear
    vData = [A1].CurrentRegion.Resize(UBound(arr) * 6): R = 1
    For i = 2 To UBound(arr)
      If Not dic.exists(arr(i, 1)) Then
         For j = 3 To UBound(arr, 2) Step 3
            If arr(i, j) <> "" Then
                R = R + 1: vData(R, 1) = arr(i, 1): vData(R, 2) = arr(i, 2)
                For k = 3 To 5
                   vData(R, k) = arr(i, (j - 3) + k)
                Next k
            End If
         Next j
         dic(arr(i, 1)) = ""
      End If
    Next i
    [A1].Resize(R, UBound(vData, 2)) = vData
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

参与一下。。。

cby0318

gwjkkkkk 发表于 2022-12-3 13:33
Sub TEST()
    Dim arr, vData, i&, j&, R&, dic As Object
    Application.ScreenUpdating = False

试了一下两位大神的方法，但是发现一个问题，身份证号码复制过去的时候身份证号码显示不全，

cby0318

蓝桥玄霜 发表于 2022-12-3 10:52
统计的例子：

提取到新表的身份证格式不对，显示不全。

gwjkkkkk

cby0318 发表于 2022-12-3 23:02
试了一下两位大神的方法，但是发现一个问题，身份证号码复制过去的时候身份证号码显示不全，

简单改一下就行了，请参考附件。。。