扇形的多级表如何规范化优化？

HYH281 · 发表于 2015-8-26 09:03

请问：如附件所示的扇形的多级表如何规范化优化？多谢了

zxb7679 · 发表于 2015-8-27 19:17

什么扇形，就是一般的BOM表结构，一般用 id，节点，父节点这种结构就可以了，但是要展开的话，需要算法的！

amazeyeli · 发表于 2015-8-31 18:50

name father_name
a A
b A
...
A 1
B 1
...

zhenghui13 · 发表于 2015-9-14 13:26

树形结构，留记。有时间做。

HYH281 · 发表于 2015-9-25 11:10

zhenghui13 发表于 2015-9-14 13:26
树形结构，留记。有时间做。

应叫树形，请帮忙优化，多谢和麻烦了

Renco · 发表于 2015-9-25 12:20

3楼的，已经给你答案了。

HYH281 · 发表于 2015-9-25 15:16

Renco 发表于 2015-9-25 12:20
3楼的，已经给你答案了。

没看懂，能否详细指点下，多谢了

Renco · 发表于 2015-9-28 09:32

只是结构的话，就二个字段，
上级，下级

在算法上，叫作递归，想了解的话，可以加我Q，但只有晚上有空

zhenghui13 · 发表于 2015-9-29 20:02

我只会将数据转成3楼的那种结构，反向转换不会;

Option Explicit
'一般BOM的展开,暂时不清楚具体数据结构
'默认数据会根据层级不断向后延展
'默认数据总是有序排序(如果数据是无序排序，可以用字典以便记录唯一性)
Private Type Node
Child As Variant
Parent As Integer
Data As String
Level As Integer
End Type
Public arrNode() As Node, iNode&
Public SS_Level(), SS_Top&
Public Dic As Object, iDic&
Public arrOut(), iOut&
Const Root = 0
Sub BOM_Extend()
Dim arr
Dim i&, j&
'--------------------------
'初始化数据
arr = Sheet1.UsedRange
ReDim arrNode(0 To 50)
ReDim SS_Level(0 To UBound(arr, 2)) '堆栈层级
Set Dic = CreateObject("Scripting.Dictionary")
ReDim arrOut(1 To 50, 1 To UBound(arr, 2))
'--------------------------
iNode = Root
arrNode(iNode).Data = "Root"
arrNode(iNode).Level = Root
'ReDim arrNode(iNode).Child(0)
'Dic("Root") = iNode
SS_Top = Root
SS_Level(SS_Top) = "Root"
For i = 1 To UBound(arr)
'If i = 9 Then Stop
j = 1
Do While j <= UBound(arr, 2)
If j = 0 Then j = j + 1
'边界
If SS_Top > j Then
'栈内层>BOM层
j = j + 1
'BOM层后移一位
ElseIf SS_Top = j Then
'层级相同
If SS_Level(SS_Top) = arr(i, j) Then
'栈=BOM
j = j + 1
'BOM层后移一位
ElseIf SS_Level(SS_Top) <> arr(i, j) Then
'内容不同
SS_Pop
'出栈
j = j - 1
End If
ElseIf SS_Top < j Then
'栈内层<BOM层
SS_Push arr(i, j)
'压入栈
NodeIn LongFatherChain(SS_Top - 1), arr(i, j)
'数据记录结点
End If
Loop
Next i
'Stop
'============================================
Node2Sheet (Root)
Sheet2.UsedRange.ClearContents
Sheet2.[A1].Resize(UBound(arrOut), UBound(arrOut, 2)) = arrOut
'-------------------------------------------
ReleaseMemory
Erase arr
End Sub
Sub Node2Sheet(n)
'n为Node信息
Dim i As Long
iOut = iOut + 1
arrOut(iOut, 1) = arrNode(n).Level
If arrNode(n).Parent = 0 Then
'根结点的父节点问题
arrOut(iOut, 2) = 0
Else
arrOut(iOut, 2) = arrNode(arrNode(n).Parent).Data
End If
arrOut(iOut, 3) = arrNode(n).Data
If IsEmpty(arrNode(n).Child) Then Exit Sub
For i = 1 To UBound(arrNode(n).Child)
Node2Sheet (arrNode(n).Child(i))
Next i
End Sub
Function LongFatherChain(a) As String
'SK表示为长数据关系链
Dim i&
For i = 0 To a
LongFatherChain = LongFatherChain & SS_Level(i)
Next i
End Function
Sub NodeIn(f, d)
'f=father d=data
Dim i As Long
If Not Dic.Exists(f) Then
Dic(f) = iNode
'记录数据地址
ReDim arrNode(iNode).Child(0)
End If
iNode = iNode + 1
ReDim Preserve arrNode(Dic(f)).Child(0 To UBound(arrNode(Dic(f)).Child) + 1)
arrNode(Dic(f)).Child(UBound(arrNode(Dic(f)).Child)) = iNode
arrNode(iNode).Parent = Dic(f)
arrNode(iNode).Data = d
arrNode(iNode).Level = SS_Top
End Sub
'数据入栈
Sub SS_Push(Data)
If SS_Top + 1 > UBound(SS_Level) Then
'If SS_IsFull(SS_List) Then
MsgBox ("Stack is Full")
Exit Sub
Else
SS_Top = SS_Top + 1 '指针上移
SS_Level(SS_Top) = Data '数据读入
End If
End Sub
'数据出栈
Sub SS_Pop()
If SS_Top = 0 Then
MsgBox ("Stack is Empty")
Exit Sub
Else
SS_Level(SS_Top) = ""
SS_Top = SS_Top - 1
End If
End Sub
Sub ReleaseMemory()
Dic.RemoveAll: Set Dic = Nothing
Erase arrNode(): iNode = 0
Erase SS_Level: SS_Top = 0
Erase arrOut: iOut = 0
End Sub

复制代码

HYH281 · 发表于 2015-9-30 10:25

多谢各位了，我理解就是将表内的数据分解为多个父子表来规范，不知理解是否正确？

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