根据模板生成户表

h2016

这个有季度和类型的要求，更能体现字典和数组的优越性。

ykcbf1100

同一个模板搞多次啊。

h2016

ykcbf1100 发表于 2023-3-3 16:10
同一个模板搞多次啊。

不同的，这个需要汇总和分类，你看看。昨天那个没有体现字典的优势，今天这个应该是字典处理更快点，你搞一下看看

洋务德雷

编程太麻烦，我用透视表做了个，能用就用

h2016

洋务德雷 发表于 2023-3-3 16:30
编程太麻烦，我用透视表做了个，能用就用

主要是想学一下，谢谢啊，因为是多表联动，

ykcbf1100

h2016 发表于 2023-3-3 16:29
不同的，这个需要汇总和分类，你看看。昨天那个没有体现字典的优势，今天这个应该是字典处理更快点，你搞 ...

快下班了，要等到下周一再上论坛了。
让别的老师来吧。

h2016

ykcbf1100 发表于 2023-3-3 16:44
快下班了，要等到下周一再上论坛了。
让别的老师来吧。

3190496160

代码写到一半才发现，
1、模板中有两个字段：分品种收入（元），成本支出（元）。但是，从两个数据源表中根本没法判断那些是收入，哪些是支出？？
2、模板中有身份证号字段，但是，两个数据源中都没有这个字段
楼主目前为止发了四个帖子，前三个帖子都没有能完美解决，似乎应该要反思一下是为什么

3190496160

Sub 批量生成()
Application.ScreenUpdating = False
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
Set dic_1 = CreateObject("scripting.dictionary")
Set dic_2 = CreateObject("scripting.dictionary")
With Sheets("生产经营性收支")
     r = .Cells(Rows.Count, 1).End(xlUp).Row
     ar = .Range("a1:h" & r)
End With
With Sheets("户主信息")
     rs = .Cells(Rows.Count, 1).End(xlUp).Row
     br = .Range("a1:d" & rs)
End With
For i = 2 To UBound(br)
    If Trim(br(i, 1)) <> "" Then
        dc(Trim(br(i, 1))) = br(i, 3)
    End If
Next i
For i = 2 To UBound(ar)
    If Trim(ar(i, 1)) <> "" Then
        d(Trim(ar(i, 1))) = ""
    End If
Next i
Application.DisplayAlerts = False
For Each sh In Sheets
    If sh.Index > 3 Then sh.Delete
Next sh
Application.DisplayAlerts = True
For Each k In d.keys
    n = 0: m = 0: dic_1.RemoveAll: dic_2.RemoveAll
    ReDim arr(1 To UBound(ar), 1 To 12)
    ReDim brr(1 To UBound(ar), 1 To 12)
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) = k Then
            hz = ar(i, 2)
            rs = dc(k)
            If Trim(ar(i, 5)) <> "种植业" Then
                n = n + 1
                arr(n, 1) = ar(i, 3)
                arr(n, 2) = ar(i, 7)
                arr(n, 11) = ar(i, 8)
                dic_1(ar(i, 3)) = dic_1(ar(i, 3)) + ar(i, 8)
            Else
                m = m + 1
                brr(m, 1) = ar(i, 3)
                brr(m, 2) = ar(i, 7)
                brr(m, 11) = ar(i, 8)
                dic_2(ar(i, 3)) = dic_2(ar(i, 3)) + ar(i, 8)
            End If
        End If
    Next i
    Sheets("模板").Copy after:=Sheets(Sheets.Count)
    With ActiveSheet
        .Name = hz & "_" & k
        .[a2] = "户主姓名：" & hz & "               身份证号码：                  家庭常住人口数：" & rs & "    人  "
        If n > 0 Then
            .[a7].Resize(n, UBound(arr, 2)) = arr
            .[c27] = dic_1(1)
            .[f27] = dic_1(2)
            .[i27] = dic_1(3)
            .[l27] = dic_1(4)
        End If
        If m > 0 Then
            .[a33].Resize(m, UBound(arr, 2)) = brr
            .[c48] = dic_2(1)
            .[f48] = dic_2(2)
            .[i48] = dic_2(3)
            .[l48] = dic_2(4)
        End If
    End With
Next k
Sheets("生产经营性收支").Select
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

按户主信息和生产经营性表根据模板生成户表.rar (154.01 KB, 下载次数: 27)

2023-3-4 09:46 上传

点击文件名下载附件