[已解决]帮助修改代码，按条件分类复制到指定单元格

yhq124

要求：
       目前已实现按条件（门牌号）复制模板并命名工作表，现需要按门牌号将信息表中的A5~A22的数据提取到门牌号工作表B11~T26工作区域中，要求从B11行开始，根据家庭人员情况逐行逐条提取。
      目前程序不能按门牌号提取全部家庭人员信息，只能提取一条信息，是从B18开始，

最佳答案

月排行榜 / 总排行榜

cutecpu

2021-5-30 10:23

Sub demo()
   Set d = CreateObject("scripting.dictionary")
   a = Sheet1.[a1].CurrentRegion
   For i = 3 To UBound(a)
      d(a(i, 5)) = i
   Next
   Set o = Sheet1.Range("o1:ag" & UBound(a))
   s = 2
   For sh = 3 To Sheets.Count
      With Sheets(sh)
         e = d(.Name)
         ot = o.Offset(s, 0).Resize(e - s, 19)
         .[b11:u26].ClearContents
         .[b11].Resize(e - s, 19) = ot
      End With
      s = e
   Next
End Sub


祝順心，南無阿彌陀佛！

跳转到最佳答案楼层

cutecpu

Sub demo()
   Set d = CreateObject("scripting.dictionary")
   a = Sheet1.[a1].CurrentRegion
   For i = 3 To UBound(a)
      d(a(i, 5)) = i
   Next
   Set o = Sheet1.Range("o1:ag" & UBound(a))
   s = 2
   For sh = 3 To Sheets.Count
      With Sheets(sh)
         e = d(.Name)
         ot = o.Offset(s, 0).Resize(e - s, 19)
         .[b11:u26].ClearContents
         .[b11].Resize(e - s, 19) = ot
      End With
      s = e
   Next
End Sub


祝順心，南無阿彌陀佛！

yhq124

cutecpu 发表于 2021-5-30 12:25
Sub demo()
   Set d = CreateObject("scripting.dictionary")
   a = Sheet1.[a1].CurrentRegion

大神，能不能把你写的模块整合到我原来的模块中，一次性完成以下两个功能
   1.根据门牌号复制模板工作表，并将新工作表命名为门牌号
   2.将信息表中的A5~A22的数据提取到门牌号工作表B11~T26工作区域中，要求从B11行开始，根据家庭人员情况逐行逐条提取。

cutecpu

yhq124 发表于 2021-5-30 12:43
大神，能不能把你写的模块整合到我原来的模块中，一次性完成以下两个功能
   1.根据门牌号复制模板工作 ...

您好，您把剛剛上傳給您的附件裡
在您原本的模塊最後 加上 demo 就可以了喔！

祝順心，南無阿彌陀佛！

yhq124

cutecpu 发表于 2021-5-30 12:55
您好，您把剛剛上傳給您的附件裡
在您原本的模塊最後 加上 demo 就可以了喔！

谢谢，我现在试试，以后多多指教