主题：[分享]将单列的Structure.rtf转化为多列的Excel格式

建议狐爸在【输出结构】时直接转成《Structure.xls》。就不用本代码了。

  点击【输出结构】生成的《Structure.rtf》文件，每行混合了列名、标题、类型、长度、表达式，不便于相关数据的统一。

  例1，列名【项目名称】的长度，在不同的表中可能会不一样，在rtf文档中只能逐个搜索、比较、修改，但如果整理为Excel文档，把上述5项存放到5列，就可以整体排序、比较、修改了。

  例2，【立项申请】表中的【项目名称】长度为50，立项申请审批通过后，点击【受理】按钮时，会在【项目管理】表中自动增加一条记录，如果【项目管理】表的【项目名称】长度为45，明显不足，则后面的字符会被截断。如果两表的长度反过来，则【项目管理】表的【项目名称】长度又多余5。必须统一。

  例3，工龄（如15年）和工龄工资（20元/年）都可以是微整数，但年功工资=工龄*工龄工资=300元，不管什么类型，此时系统就会出错。应按帮助文档的建议，全部改为整数。这就需要排序、确认、修改。

  整理步骤如下。整理后A列为《Structure.rtf》原文,B列至F列分别为上述5项。

  1 从项目中点击菜单按钮"输出结构",会自动打开生成的结构文件Structure.rtf,按Ctrl+A全选,按Ctrl+C复制。

  2 打开Excel,在空白工作薄的第一张工作表中选A1单元格,按Ctrl+V粘贴,按Ctrl+W保存、关闭。

  3 在命令窗口中运行下列代码(或把下列代码作为一个按钮的代码)，选择刚才保存的Excel表结构文件。

Dim filename As String

Dim dlg As New OpenFileDialog

dlg.Filter = "Excel文件|*.xls;*.xlsx"

If dlg.ShowDialog = DialogResult.OK Then

  filename = dlg.FileName

Else

  Return nothing

End If

Dim App As New MSExcel.Application

Dim book As MSExcel.WorkBook = App.WorkBooks.Open(filename)

Dim ws As MSExcel.WorkSheet = book.WorkSheets(1)

Dim rg As MSExcel.Range = ws.usedRange

Dim str,str1 As String

Dim i,j,k As Integer

app.visible = False

For i = 1 To Rg.Rows.Count

  str = Ws.Cells(i,1).value

  If str = "" Then

     Continue For

  End If

  str = str.trim

  If str.StartsWith("关联") Then

     Exit For

  End If

  If not str.Contains(">") Then

     Ws.Cells(i,2) = str '表名

     Continue For

  End If

  j = str.IndexOf("(")

  Ws.Cells(i,2) = str.SubString(0,j) '列名

  k = str.IndexOf(")")

  If k > j + 1 Then '有标题

     Ws.Cells(i,3) = str.SubString(j+1,k-j-1) '标题

  End If

  j = str.IndexOf(">")

  str = str.SubString(j+1).Trim '从类型开始的后半部分,没有表达式时就是类型和长度

  If str.Contains(">") Then '有表达式

     k = str.IndexOf("-")

     str1 = str.SubString(0,k-1).Trim '取类型和长度部分

     j = str.IndexOf(">")

     Ws.Cells(i,6) = str.SubString(j+1).Trim '表达式

     If str1.StartsWith("字符型") Then

        Ws.Cells(i,4) = "string" '类型

        Ws.Cells(i,5) = str1.SubString(4,str1.Length-5) '长度

        If str1.SubString(4,str1.Length-5)="1073741823" Then

           Ws.Cells(i,4) = "text"

           Ws.Cells(i,5) = Nothing

        End If

        Continue For

     Else

        goto SYL1

    End If

  Else '无表达式,只是类型和长度

     str1 = str

     If str1.StartsWith("字符型") Then

        Ws.Cells(i,4) = "string" '类型

        Ws.Cells(i,5) = str1.SubString(4,str1.Length-5) '长度

        If str1.SubString(4,str1.Length-5)="1073741823" Then

           Ws.Cells(i,4) = "text"

           Ws.Cells(i,5) = Nothing

        End If

        Continue For

     Else

        goto SYL1

     End If

  End If

  SYL1:

  Select str1

     Case "备注型"

        Ws.Cells(i,4) = "Text"

     Case "日期型"

        Ws.Cells(i,4) = "datetime"

     Case "逻辑型"

        Ws.Cells(i,4) = "boolean"

     Case "长整数"

        Ws.Cells(i,4) = "long"

     Case "单精度小数"

        Ws.Cells(i,4) = "single"

     Case "双精度小数"

       Ws.Cells(i,4) = "double"

     Case "高精度小数"

        Ws.Cells(i,4) = "double" '不考虑

     Case Else

        Ws.Cells(i,4) = "integer" '不考虑微整数和短整数

  End Select

Next

book.save

app.visible = True

收到，谢谢您的建议。