堆栈空间不足怎么办

icharisma · 发表于 2020-1-30 00:13

求大神帮我看看这段代码为什么老是提示堆栈空间不足？帮忙改下，万分感激

父件在B列（共有将近2万条数据），子件在C列。

Public k%
Sub Tree(searchstr As String, depth As Integer)
If [b:b].Find(searchstr, , , 1) Is Nothing Then
Cells(k, depth + 6) = searchstr
k = k + 1
Exit Sub
End If
Dim rng As Range
For Each rng In Range([b3], [b65536].End(xlUp))
If rng = searchstr Then
      If [b:b].Find(rng, , , 1).Address = rng.Address Then
         Cells(k, depth + 6) = rng
         k = k + 1
      End If
      Call Tree(rng.Offset(0, 1), depth + 1)
End If
Next
End Sub

Sub main()
k = 2
Dim i%
For i = 3 To [b65536].End(xlUp).Row
If [c:c].Find(Cells(i, 2), , , 1) Is Nothing And _
      [b:b].Find(Cells(i, 2), , , 1).Row = i Then
      Call Tree(Cells(i, 2), 0)
End If
Next
End Sub

microyip · 发表于 2020-1-30 07:55

如果没猜错，i%，m%的定义不足，改成i as long，m as long

microyip · 发表于 2020-1-30 07:57

下次记得把附件附上方便别人了解实际情况

icharisma · 发表于 2020-1-30 09:40

microyip 发表于 2020-1-30 07:57
下次记得把附件附上方便别人了解实际情况

非常感谢快速回复，菜鸟一枚，忽略了附件问题，附件如下

@父子关系转化为树形结构.zip (75.78 KB, 下载次数: 6)

，只有1000条数据的话，也会显示“堆栈空间不足”，有劳帮改一下，非常感谢！

microyip · 发表于 2020-1-30 10:18

没看出什么问题,但这种分类列表,用字典记录一下即可

一把小刀闯天下 · 发表于 2020-1-30 10:28

试了一下进入无限循环
667行<->1027行互为父子，所以不爆掉才不正常，，，

icharisma · 发表于 2020-1-30 10:29

microyip 发表于 2020-1-30 10:18
没看出什么问题,但这种分类列表,用字典记录一下即可

对VBA实在不灵，完全0零基础，执行时就是报错，执行不完，能帮简单修改下吗？字典也不知道该怎么弄，多谢！

microyip · 发表于 2020-1-30 10:51

本帖最后由 microyip 于 2020-1-30 10:52 编辑

icharisma 发表于 2020-1-30 10:29
对VBA实在不灵，完全0零基础，执行时就是报错，执行不完，能帮简单修改下吗？字典也不知道该怎么弄，多谢 ...

我执行你的代码时一样会出错，但没看出什么问题，你原来的需求也不清不楚，看代码看得也是一头雾水

microyip · 发表于 2020-1-30 11:02

Sub 分类()
Dim vData As Variant, nRow As Double, oDic As Object
Dim vKey1 As Variant, vKey2 As Variant
Set oDic = CreateObject("Scripting.Dictionary")
With Sheet1
vData = .[B2].CurrentRegion.Value
For nRow = 2 To UBound(vData)
If Not oDic.Exists(vData(nRow, 1)) Then Set oDic(vData(nRow, 1)) = CreateObject("Scripting.Dictionary")
oDic(vData(nRow, 1))(vData(nRow, 2)) = 0
Next
ReDim vData(1 To 2, 0)
nRow = 0
For Each vKey1 In oDic.Keys
nRow = nRow + 1
ReDim Preserve vData(1 To 2, 1 To nRow)
vData(1, nRow) = vKey1
For Each vKey2 In oDic(vKey1).Keys
nRow = nRow + 1
ReDim Preserve vData(1 To 2, 1 To nRow)
vData(2, nRow) = vKey2
Next
Next
.[F2].Resize(.UsedRange.Rows.Count, .UsedRange.Columns.Count).ClearContents
If nRow > 0 Then .[F2].Resize(nRow, 2) = Application.WorksheetFunction.Transpose(vData)
End With
End Sub

复制代码

microyip · 发表于 2020-1-30 11:03

附上附件以供参考

		自动登录	找回密码
密码			免费注册

[求助] 堆栈空间不足怎么办

评分