100求一个算法?DOS时代画了一个表参考
现有一个树状数据存在数据库中.
编码 名称
001 a
001001 b
001002 c
001003 d
001003001 e
001003002 f
001004 g
001005 h
001006 i
001006001 j
001006001001 k
001006001002 l
001006002 m
001001是001的子级,以此类推.如001是所有级的父级.
现需求如下:将数据形成表格的算法.
---------------------------------------------|------------|
类别 | 数量 |
------|--------------------------------------|------------|
| 001001 | 1 |
|--------------------------------------|------------|
| 001002 | 2 |
|----------|---------------------------|------------|
| | 001003001 | 1 |
| |---------------------------|------------|
| 001003 | 001003002 | 5 |
| |---------------------------|------------|
| | 合 计 | 6 |
|----------|---------------------------|------------|
| 001004 | 5 |
|--------------------------------------|------------|
001 | 001005 | 7 |
|---------|-------------|--------------|------------|
| | | 001006001001 | 4 |
| | |--------------|------------|
| | 001006001 | 001006001002 | 2 |
| | |--------------|------------|
| 001006 | | 合计 | 6 |
| |-------------|--------------|------------|
| | 001006002 | 4 |
| |----------------------------|------------|
| | 合 计 | 10 |
|---------|----------------------------|------------|
| 合 计 | 31 |
------|--------------------------------------|------------|
第一个级别有一个合计.
怎样才能让表格成这种样子.表格具有合并的功能(类似电子表格).
[解决办法]
如果001003是001003001和001003002的父项，那个001003本身是没有值的吧
那么只要是父项 都是没有值的。是这样吗？
[解决办法]
好像很复杂啊，顶起来
[解决办法]
顶，学习中
[解决办法]
很典型的递归
[解决办法]
就生成一棵树,再递归生成表格吧.
[解决办法]
关注LZ，友情UP一下
[解决办法]
更好的办法? 我觉得这玩意最好就是用递归了.
generate(currentnode)
{
if (currentnode.haschild)
generate(currendnode,child)
else
print "XXxXX "
}
大概如此吧.
[解决办法]
类似MRP里的BOM展阶.
[解决办法]
你这个是什么意思??如果你做个无限树跟统计树节点数目的话..我做过!!
[解决办法]
Option Explicit
Private Sub CmdLoad_Click()
CreatCellHeadThree
End Sub
Private Sub Form_Load()
' '创建表,你自己在SQL上运行
' ' CREATE TABLE [Subject] (
' ' [Code] [varchar] (50) COLLATE Chinese_PRC_CI_AS NOT NULL ,
' ' [Name] [nvarchar] (50) COLLATE Chinese_PRC_CI_AS NULL ,
' ' [Num] [decimal](18, 2) NULL CONSTRAINT [DF_Subject_Num] DEFAULT (0),
' ' CONSTRAINT [PK_Subject] PRIMARY KEY CLUSTERED
' ' (
' ' [Code]
' ' ) ON [PRIMARY]
' ' ) ON [PRIMARY]
' ' GO
Cell.Height = Me.ScaleHeight - Cell.Top
Cell.Width = Me.ScaleWidth
End Sub
Private Sub Form_Resize()
Cell.Height = Me.ScaleHeight - Cell.Top
Cell.Width = Me.ScaleWidth
End Sub
Private Sub Form_Unload(Cancel As Integer)
If Connect.State = 1 Then Connect.Close
Unload Me
End Sub
Private Sub CreatCellHeadThree()
Dim HeadRs As New ADODB.Recordset ' '表头记录集,由此记录集创建表头
Dim End_subjects As Long ' '末级科目数
Dim Sum_Items As Long ' '合计项数
Dim TotalsCol As Long
Dim Layer As Long ' '层数
Dim TheSqlStr As String
Dim I As Long
' '横报表表头所占行数为科目层数
' '横报表表头所占列数为:末级科目数+合计项数=总列科目数
' 'Select Max(Len(Code))/Min(Len(Code)) From Subject--层数
' '表固定列第一列季度，第二列总计
With Cell
' '清除表格
.ClearArea 1, 1, 5, 6, 0, 32
.SetRows 4, 0 ' '初始行数据
.SetCols 5, 0 ' '初始列数
.SetCurSheet 0
.SetFixedRow 1, 5 ' ' '一到四行为固定行
.RdonlyCellColor = RGB(255, 255, 255)
.ShowSheetLabel 0, 0 '不显示页
.SetRowHeight 1, 50, 1, 0
.DrawGridLine 1, 3, .GetCols(0) - 1, .GetRows(0) - 1, 0, 2, -1
If HeadRs.State = 1 Then HeadRs.Close: Set HeadRs = Nothing
TheSqlStr = "select Count(*) as Cols ,Max(Len(Code))/Min(Len(Code))as Layers from Subject " ' '总列数
HeadRs.Open TheSqlStr, Connect, adOpenKeyset, adLockOptimistic
TotalsCol = HeadRs.Fields( "Cols ").Value ' '总列数 表头列数
Layer = HeadRs.Fields( "Layers ").Value ' '总层数 表头行
.SetRows Layer + 2, 0 ' '初始行数据
.SetCols TotalsCol + 1, 0 ' '初始列数
' ' '以上确定了报表的行和列
TheSqlStr = "Select Code,Name,Num, " & vbCrLf & _
"子科目数= (Select Count(*)-1 from Subject where Code like rtrim(A.Code)+ '% ') " & vbCrLf & _
",层数=(select len(Code)/3) " & vbCrLf & _
"From Subject A Order by Code "
If HeadRs.State = 1 Then HeadRs.Close: Set HeadRs = Nothing
HeadRs.Open TheSqlStr, Connect, adOpenKeyset, adLockOptimistic
' 'Code , Name, Num, 子科目数,层数
For I = 1 To HeadRs.RecordCount
.S I, HeadRs.Fields( "层数 ").Value, 0, HeadRs.Fields( "Name ").Value ' ' '& "( " & HeadRs.Fields( "Code ").Value & ") " ' '标题头
.D I, Layer + 1, 0, GetTatol(HeadRs.Fields( "Code ").Value)
If HeadRs.Fields( "子科目数 ") > 0 Then
.S I, HeadRs.Fields( "层数 ").Value + 1, 0, "合计: "
.SetCellTextColor I, HeadRs.Fields( "层数 ").Value + 1, 0, .FindColorIndex(RGB(255, 0, 0), 1) ' '上色
.MergeCells I, HeadRs.Fields( "层数 ").Value, I + HeadRs.Fields( "子科目数 ").Value, HeadRs.Fields( "层数 ").Value
End If
HeadRs.MoveNext
Next
End With
End Sub
Private Function GetTatol(ItemCode) As Double
Dim TheRs As New ADODB.Recordset
Dim TheSql As String
GetTatol = 0
TheSql = "select sum(Num)as 合计数 From Subject where Code Like ' " & ItemCode & "% ' "
TheRs.Open TheSql, Connect, adOpenKeyset, adLockReadOnly
GetTatol = TheRs.Fields( "合计数 ").Value
TheRs.Close
Set TheRs = Nothing
End Function
