求助大神帮忙，根据前面黄色的几个总表，按着模板的样式，拆分成子账单

ss1357438178

求助大神帮忙，根据前面黄色的几个总表，按着模板的样式，拆分成子账单。我也看了很久的vba教学，代码实在太多，还是没有学到可以自己做的地步。麻烦大神，帮忙写一下代码，然后再做一个文档，帮忙给代码解释一下，每一句是什么意思，我想自己可以理解。万分感谢啦！不知道为什么被提示单个文件不得超过2MB，实际并没有超，上传不了附件。大神可以留个联系方式，我私发给你呀！

wggx4

什么都没有，怎么做啊

3190496160

精简附件上传，或者，上淘宝找人解决，不然，没有人有这份闲心做这个义务的，得帮你写代码，还得帮你注释代码，

ss1357438178

wggx4 发表于 2020-2-28 07:28
什么都没有，怎么做啊

终于把附件调小了，拜托啦！

ss1357438178

wggx4 发表于 2020-2-28 07:28
什么都没有，怎么做啊

我明明加了附件的，去哪了

ss1357438178

3190496160 发表于 2020-2-28 07:50
精简附件上传，或者，上淘宝找人解决，不然，没有人有这份闲心做这个义务的，得帮你写代码，还得帮你注释代 ...

我知道我是很贪心的啦！淘宝上大家都是讲效率的，在这里总感觉可以多学到一些。本来是想开通悬赏贴的，希望可以补偿一点点，只是还没弄明白怎样操作。

ss1357438178

wggx4 发表于 2020-2-28 07:28
什么都没有，怎么做啊

拜托了大神！做好可以发我微信吗？v：ss1357438178，希望可以补你红包，万分感谢！

3190496160

Sub test()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    For Each sh In Sheets
        If sh.Index > 6 Then sh.Delete
    Next sh
Application.DisplayAlerts = True
    ar = Sheets("水费").[a1].CurrentRegion
    For i = 3 To UBound(ar)
        If Len(Trim(ar(i, 1))) <> 0 Then
            Sheets("模板").Copy after:=Sheets(Sheets.Count)
            With Sheets(Sheets.Count)
                .Name = ar(i, 1)
                Set Rng = Sheets("饮用水").Columns(1).Find(ar(i, 1), , , 1)
                If Not Rng Is Nothing Then
                    r = Rng.Row
                    .Cells(6, 2) = Sheets("饮用水").Cells(r, 3)
                    .Cells(6, 3) = Sheets("饮用水").Cells(r, 2)
                    .Cells(6, 4) = Sheets("饮用水").Cells(r, 4)
                End If
                Set Rng = Nothing
                Set Rng = Sheets("电费").Columns(6).Find(ar(i, 1), , , 1)
                If Not Rng Is Nothing Then
                    r = Rng.Row
                    .Cells(7, 4) = Sheets("电费").Cells(r, 13)
                End If
                Set Rng = Nothing
                 Set Rng = Sheets("水费").Columns(1).Find(ar(i, 1), , , 1)
                If Not Rng Is Nothing Then
                    r = Rng.Row
                    .Cells(8, 4) = Sheets("水费").Cells(r, 6)
                End If
                Set Rng = Nothing
                 Set Rng = Sheets("房租").Columns(2).Find(ar(i, 1), , , 1)
                If Not Rng Is Nothing Then
                    r = Rng.Row
                    .Cells(9, 4) = Sheets("房租").Cells(r, 4)
                End If
                Set Rng = Nothing
                 Set Rng = Sheets("用餐人数").Columns(1).Find(ar(i, 1), , , 1)
                If Not Rng Is Nothing Then
                    r = Rng.Row
                    .Cells(14, 3) = Sheets("用餐人数").Cells(r, 37)
                    .Cells(15, 3) = Sheets("用餐人数").Cells(r, 38)
                End If
                Set Rng = Nothing
            End With
        End If
    Next i
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

账单 - 求助3.rar (840.2 KB, 下载次数: 15)

2020-2-28 11:39 上传

点击文件名下载附件

3190496160

表格比较乱，代码可能不一定完全适合您的需求，已经加你微信，可以具体沟通