PD建模使用Excel快速完成
作者:互联网
在NC开发中,数据建模的工作量非常大,在PD中进行大量的操作,而且出错率很高,经过各处查询资料,当然都是各位大佬级的资料学习,汇总如下,可能有的代码是各位前辈的,在此引用,不便之处请指正。
一、先设计好数据库定义,并将定义输入到Excel表中,具体EXCEL表的格式如下图:
二、将上面做好的Excel表保存在硬盘上,这里假设保存在e:\db.xlsx,数据都放在sheet1中,启动PD,按下图样操作:
三、在新打开的Edt/Run Script窗口中输入如下代码后,点Run;
Option Explicit Dim mdl ' the current model Set mdl = ActiveModel If (mdl Is Nothing) Then MsgBox "There is no Active Model" End If Dim HaveExcel Dim RQ Dim x1sApp,xlsWorkBook,xlsSheet RQ = vbYes 'MsgBox("Is Excel Installed on your machine ?", vbYesNo + vbInformation, "Confirmation") If RQ = vbYes Then HaveExcel = True ' Open & Create Excel Document Set x1sApp = CreateObject("Excel.Application") set xlsWorkBook = x1sApp.Workbooks.Open("E:\db.xlsx") '指定excel文档路径 set xlsSheet = x1sApp.Workbooks(1).Worksheets("sheet1") '指定要打开的sheet名称 Else HaveExcel = False End If a x1sApp, mdl,x1sApp,xlsWorkBook,xlsSheet sub a(x1, mdl,x1sApp,xlsWorkBook,xlsSheet) dim rwIndex dim tableName dim colname dim table dim col dim count dim rowCount tableName = "" rowCount = xlsSheet.usedRange.Rows.Count on error Resume Next For rwIndex = 2 To rowCount '指定要遍历的Excel行标 由于第1行是表头,从第2行开始 With xlsSheet If .Cells(rwIndex, 2).Value = "" Then '如果遍历到第2列为空,则退出 Exit For End If If tableName <> .Cells(rwIndex,2) Then '如果表名不同,则表示新建表 set table = mdl.Tables.CreateNew '创建表 table.Name = lcase(.Cells(rwIndex , 3).Value) '指定表名,第2列的值 table.Code = .Cells(rwIndex , 2).Value table.Comment = .Cells(rwIndex , 3).Value '指定表注释,第3列的值 count = count + 1 tableName = .Cells(rwIndex,2) '获取表名 end if set col = table.Columns.CreateNew '创建一列/字段 'MsgBox .Cells(rwIndex, 1).Value, vbOK + vbInformation, "列" if .Cells(rwIndex,5).Value = "" then '指定列名,如果备注不为空,则用备注信息,否则用code的全小写信息 col.Name = lcase(.Cells(rwIndex, 4).Value) else col.Name = .Cells(rwIndex,5).Value end if 'MsgBox col.Name, vbOK + vbInformation, "列" col.Code = .Cells(rwIndex, 4).Value '指定列编码 col.DataType = .Cells(rwIndex, 7).Value '指定列数据类型 'MsgBox col.DataType, vbOK + vbInformation, "列类型" col.Comment = .Cells(rwIndex,6).Value '指定列说明 if .Cells(rwIndex, 8).Value = "Y" Then '设置主键信息 col.Primary = true End If if .Cells(rwIndex, 10).Value = "Y" Then '设置主键自增长 col.Identity = true End If If.Cells(rwIndex, 9).Value = "NO" Then '设置非空属性 col.Mandatory =true End If End With Next MsgBox "生成数据表结构共计 " + CStr(count), vbOK + vbInformation, "表" xlsWorkBook.Close x1sApp.Quit set x1sApp = nothing set xlsWorkBook = nothing Exit Sub End sub
四、OK,生成了,看图。
标签:End,Cells,Excel,建模,Value,rwIndex,PD,x1sApp,col 来源: https://www.cnblogs.com/Chengjr/p/14007048.html