项目需求

客户整理出一个excel表格，表格中有订单必需的几个字段。然后把表格批量到导入到金蝶的专业版订单中。

如图：

项目开发思路：用vba代码把这个原表中需要的字段提取出来。然后生成到新的一张excel表格中，订单需要的字段能固定的，都固定写在生成导入表格里，

不能固定的，用vba代码写一个窗体，菜单，让客户可以简单选择。

如图：

项目开发过程及主要代码：

Private Sub UserForm_Initialize()

TextBox1.Text = Format(Date, "yyyy-m-d")

End Sub

Private Sub CommandButton1_Click()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strCn As String, strSQL As String '字符串变量
strCn = "Driver={sql server};" _
& "server=192.168.42.141;" _
& "uid=sa;pwd=sa123456;" _
& "database=AIS20181129203623;" _
& "AutoTranslate=False"

strSQL = "select * from zj1"

cn.Open strCn '打开连接
rs.Open strSQL, cn
Dim i As Integer, j As Integer, sht As Worksheet 'i,j为整数变量；sht 为excel工作表对象变量，指向某一工作表

Set sht = ThisWorkbook.Worksheets("w1")
'sht.Range("a1:a4") = rs("fexplanation")
'循环读取数据并将数据显示到excel中
i = 1
Do While Not rs.EOF '当数据指针未移到记录集末尾时，循环下列操作

i = i + 1
sht.Cells(i, 1) = rs("a1") '把当前记录的字段1的值保存到sheet1工作表的第i行第1列
sht.Cells(i, 2) = rs("a2") '把当前字段2的值保存到sheet1工作表的第i行第2列
sht.Cells(i, 3) = rs("a3") '把当前字段2的值保存到sheet1工作表的第i行第2列
sht.Cells(i, 4) = rs("a4")
sht.Cells(i, 5) = rs("a5")
rs.MoveNext '把指针移向下一条记录

'i = i + 1 'i加1，准备把下一记录相关字段的值保存到工作表的下一行

Loop '循环

rs.Close '关闭记录集，至此，程序将把某数据表的字段1和字段2保存在excel工作表sheet1的第1、2列，行数等于数据表的记录数
Sheet3.Cells(1, 1) = "单位组"
Sheet3.Cells(1, 2) = "单位"
Sheet3.Cells(1, 3) = "名称"
Sheet3.Cells(1, 4) = "单价"
Sheet3.Cells(1, 5) = "代码"
End Sub

Private Sub CommandButton4_Click()
Dim aa, ab As Integer
Dim a1, b1
'循环匹配物料名称和计量单位,单价
For aa = 2 To Sheet1.[b65536].End(3).Row
a1 = Sheet1.Cells(aa, 2).Value
For ab = 2 To Sheet3.[a65536].End(3).Row
b1 = Sheet3.Cells(ab, 3).Value
If b1 = a1 Then
Sheet2.Cells(aa, 12) = Sheet3.Cells(ab, 5)
Sheet2.Cells(aa, 16) = Sheet3.Cells(ab, 4)
Sheet2.Cells(aa, 15) = Sheet3.Cells(ab, 2)
End If
Next
Next
Dim d, t As String
c = Year(Now)
d = Format(Date, "md") '当前年月日
t = Format(Time, "hms") '当前时间
Sheet2.Range("b:b").NumberFormatLocal = "yyyy-m-d"
Sheet2.Range("f:f").NumberFormatLocal = "yyyy-m-d"
Sheet2.Range("t:t").NumberFormatLocal = "yyyy-m-d"
Dim a
For a = 2 To Sheet1.[b65536].End(3).Row
Sheet2.Cells(a, 1) = "SEOR" & c & d & t & a
Sheet2.Cells(a, 2) = TextBox1.Text
Sheet2.Cells(a, 3) = Sheet1.Cells(a, 4) & "/" & Sheet1.Cells(a, 5)
Sheet2.Cells(a, 4) = "人民币"
Sheet2.Cells(a, 5) = "'1"
Sheet2.Cells(a, 6) = TextBox1.Text
Sheet2.Cells(a, 7) = "赊销"

Sheet2.Cells(a, 10) = "'*"

Sheet2.Cells(a, 13) = Sheet1.Cells(a, 2)
'Sheet2.Cells(a, 13) = Sheet1.Cells(a, 4)

Sheet2.Cells(a, 17) = Sheet1.Cells(a, 3)

Sheet2.Cells(a, 18) = "'16"
Sheet2.Cells(a, 19) = "'0"
Sheet2.Cells(a, 20) = TextBox1.Text

Next
End Sub

Private Sub CommandButton5_Click()
For Z = 2 To Sheet2.[b65536].End(3).Row

Next
Application.ScreenUpdating = False
Dim j As Integer
Dim souce As Worksheet
Dim target As Workbook
Set souce = ThisWorkbook.Worksheets("cg1")

Set target = Workbooks.Open(ThisWorkbook.Path & "\销售.xls")
target.Sheets(1).Rows.Delete

souce.Range(souce.Cells(1, 1), souce.Cells(Z - 1, 20)).Copy target.Sheets(1).Range(target.Sheets(1).Cells(1, 1), target.Sheets(1).Cells(Z - 1, 20))

Application.ScreenUpdating = True
ActiveWorkbook.Save
ActiveWorkbook.Close

End Sub

通过以上代码把原来的表格生成以下形式

用到的sql语句

建一个视图，把物料名称，代码单位等筛选出来

CREATE VIEW zj1 AS
select t1.fname as a1 ,t2.fname as a2,t3. fname as a3 ,t3.FOrderPrice as a4 ,t3.FNumber as a5 from
t_unitgroup as t1 ,t_measureunit as t2 ,t_icitem as t3
where t1.funitgroupid =t3.funitgroupid and t2.fitemid=t3.funitid

查询视图看看效果

select* from zj1

如图

最后生成的小程序有3个表组成

如图：