父层子层结构，取某一子层和父层的信息

eagles2004

wtg321 发表于 2024-8-21 16:06
用VBA编写了一下，你可以试试看。

大神，能运行的，但是好像结果不太对, 帮忙再看看呢，谢谢啦！

eagles2004

飞天篮球猪 发表于 2024-8-6 22:28
供参考,这个104万行结果可以跑进10秒：

大神，我把spl插件搞好了，现在ecel里能运行spl函数了，但是我运行出来的结果都是在一行里的，还能再帮我看看啊，谢谢了！

飞天篮球猪

eagles2004 发表于 2024-8-21 22:55
大神，我把spl插件搞好了，现在ecel里能运行spl函数了，但是我运行出来的结果都是在一行里的，还能再帮我 ...

spltest.xlsx.zip (8.22 KB, 下载次数: 4)

2024-8-22 07:47 上传

点击文件名下载附件

zzyglgl

好复杂啊，不能搞的简单点吗？

卿远

在Sheet1中存放数据，Sheet 2中列好标题，然后运行下列程序可实现

Sub 父层子层()
Application.ScreenUpdating = False
Dim rw As Integer, rw1 As Integer, m As Integer
'rw为Sheet1中行号，rw1为Sheet2中行号，m为Sheet2中列号
rw = 2
rw1 = 1
For rw = 2 To Sheets("Sheet1").Cells(1, 1).End(xlDown).Row
      If Sheets("Sheet1").Cells(rw, 3) = "成品" Then
      '遇到成品rw1+1行
           rw1 = rw1 + 1
           Sheets("Sheet2").Cells(rw1, 1) = Sheets("Sheet1").Cells(rw, 2)
       Else
            m = Application.Match(Sheets("Sheet1").Cells(rw, 3), Sheets("Sheet2").Range("a1:d1"), 0)
            '在确认行数后，用Match函数判断列数
            If m > 0 Then
                     Sheets("Sheet2").Cells(rw1, m) = Sheets("Sheet1").Cells(rw, 2)
            End If
        End If
Next
Application.ScreenUpdating = False
      
End Sub

eagles2004

飞天篮球猪 发表于 2024-8-22 07:15

谢谢大神，完美解决我的问题！

eagles2004

wtg321 发表于 2024-8-21 16:06
用VBA编写了一下，你可以试试看。

谢谢大神的帮忙！

eagles2004

卿远 发表于 2024-8-23 10:46
在Sheet1中存放数据，Sheet 2中列好标题，然后运行下列程序可实现

Sub 父层子层()

大神，也是完美的解决了我的问题，十分感谢！