ExcelTip.Net留存知识帖 ---【注:附件之前被网盘供应商清空后,现已修复-现已修复-现已修复为本地下载!】
现在位置:首页 > E问E答 > Excel VBA > 如何实现输入编码即引用另一工作簿同编码下记录?

如何实现输入编码即引用另一工作簿同编码下记录?

作者:绿色风 分类: 时间:2022-08-17 浏览:117
楼主
wjc2090742
Q:如何实现输入编码即引用另一工作簿同编码下记录?如下2图,上图为产品录入表,下图为产品汇编表,但是下图中,编码下均有多个空单元格,要实现,上图中A列输入编码,即将下图表中,该编码起包括下面的空单元格直到下个编码期间的内容全部引用过来,如何实现?

 

 
A:
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. On Error Resume Next
  3. Application.ScreenUpdating = False
  4. Dim i&, str$, ar, arr()
  5. Workbooks.Open ThisWorkbook.Path & "\产品结构汇编.xls"
  6. With Workbooks("产品结构汇编.xls").Worksheets("组合件")
  7.     arr() = .[a4].Resize(.Cells(.Rows.Count, 2).End(3).Row - 3, 7).Value
  8. End With
  9. Workbooks("产品结构汇编.xls").Close False
  10. For i = 2 To UBound(arr, 1)
  11.     If arr(i, 1) = "" Then arr(i, 1) = arr(i - 1, 1)
  12. Next
  13. str = Cells(Cells(Rows.Count, 1).End(3).Row, 1).Text
  14. ReDim ar(1 To 5, 1 To 1)
  15. For i = 2 To UBound(arr, 1)
  16.     If InStr(str, arr(i, 1)) > 0 Then
  17.         m = m + 1
  18.         ReDim Preserve ar(1 To 5, 1 To m)
  19.         For j = 1 To 5
  20.             ar(j, m) = arr(i, j + 1)
  21.         Next
  22.     End If
  23. Next
  24. Application.EnableEvents = False
  25. Cells(Cells(Rows.Count, 1).End(3).Row, 2).Resize(UBound(ar, 2), 5) = Application.Transpose(ar)
  26. Application.EnableEvents = True
  27. Application.ScreenUpdating = True
  28. End Sub

101224-产品结构整个区域信息的引入.rar
2楼
海洋之星
小胖全才,VBA也这么厉害

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素, 经与ExcelTip.Net站长Apolloh商议并征得其同意, 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示, 供有需要的人士查询使用,也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议, 可与本人沟通提出,或于本站点留言,我们会尽快处理。 在此,感谢ExcelTip.Net站长Apolloh的支持,感谢本站点所有人**绿色风(QQ:79664738)**的支持与奉献,特此鸣谢!
------本人网名**KevinChengCW(QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表
sitemap