ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 2484|回复: 11

[求助] 哪位大神能讲解下VBA父阶展开子阶程序意思,小弟初学,正好用得上此程序!

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-3-16 15:42 | 显示全部楼层 |阅读模式
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 sclvyang 于 2019-3-16 15:46 编辑

程序如下:
Option Explicit

Sub test()
  Dim arr, i, j, k, a, b, cnt, m, n, s, t, dic
  Set dic = CreateObject("scripting.dictionary")
  arr = [a1].CurrentRegion.Offset(1)
  ReDim brr(1 To UBound(arr, 1), 1 To 10 + 2) '最多支持10级
  arr(UBound(arr, 1), 1) = "成品料号"
  ReDim crr(1 To 100) As String
  For i = 2 To UBound(arr, 1) - 1
    For j = i To UBound(arr, 1) - 1
      If arr(j + 1, 1) = "成品料号" Then
        t = arr(i, 2): cnt = 1
        For k = i + 1 To j
          If arr(k, 2) = arr(i, 2) Then cnt = cnt + 1
        Next
        For k = 1 To cnt
          For a = i To j
            If arr(a, 2) = t Then
              arr(a, 2) = vbNullString
              s = arr(a, 3)
              Call rec(arr, i, j, arr(a, 3), s)
              m = m + 1: n = 2
              brr(m, 1) = t: s = Split(s, ",")
              dic.RemoveAll
              For b = 0 To UBound(s)
                n = n + 1: brr(m, n) = s(b)
                dic(s(b)) = dic(s(b)) + 1
                If dic(s(b)) > 1 Then brr(m, 2) = "互为父子:" & s(b)
              Next
            End If
        Next a, k
        i = j: Exit For
      End If
  Next j, i
  With [e3]
    .Resize(Rows.Count - 2, UBound(brr, 2)).ClearContents
    .Resize(m, UBound(brr, 2)) = brr
  End With
End Sub

Function rec(arr, a, b, t, s)
  Dim i, j
  For i = a To b
    If arr(i, 2) = t Then
      s = s & "," & arr(i, 3)
      arr(i, 2) = vbNullString
      Call rec(arr, a, b, arr(i, 3), s)
    End If
  Next
End Function

最好注释在程序后面,拜托各位大神了!

对应工作表

对应工作表

成品料号的所有子阶展开 VB程序意思求助.zip

27.16 KB, 下载次数: 13

TA的精华主题

TA的得分主题

发表于 2019-3-16 20:06 | 显示全部楼层
一开始就学递归,有点难度                                                                                            

TA的精华主题

TA的得分主题

发表于 2019-3-16 20:09 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

TA的精华主题

TA的得分主题

发表于 2019-3-16 20:53 | 显示全部楼层
好像原贴这代码并不符合楼主要求,因为楼主后来好像修改条件了,应该还有其他人回复的。能否提供原贴链接地址?写的太多我都不记得帖子在哪里了。

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-3-17 08:15 来自手机 | 显示全部楼层
本帖最后由 sclvyang 于 2019-3-17 08:20 编辑

愿意是通过此程序的修改,达到截图所需功能!
forum.png

TA的精华主题

TA的得分主题

发表于 2019-3-17 08:28 来自手机 | 显示全部楼层
sclvyang 发表于 2019-3-17 08:15
愿意是通过此程序的修改,达到截图所需功能!

这完全就是两码事

TA的精华主题

TA的得分主题

发表于 2019-3-17 08:44 | 显示全部楼层
这个就一层,数量大用字典,不然二个循环就能解决。提供源数据(模拟),你这提供的是结果图,,,

TA的精华主题

TA的得分主题

发表于 2019-3-17 08:45 | 显示全部楼层
如果想要得到帮助,你首先得解释说明一下什么是父阶,什么是子阶,判断规则是什么,最好给出模拟结果,因为很多人跟你不是同一个行业,不明白你想要达到什么效果

TA的精华主题

TA的得分主题

发表于 2019-3-17 09:04 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
楼主大概要实现类似TreeView的效果吧

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-3-17 10:56 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
这里面包含我的原始bom表格,求助一个引用公式,一个订单的某些父阶物料需要引用BOM的子阶物料,BOM在另外一个表格,如何将数据按父阶物料的图号引用,不知你们懂了我说的意思没!
123.png

根据父阶料号展开其子阶2019.rar

26 KB, 下载次数: 5

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 07:46 , Processed in 0.048529 second(s), 10 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表