送货单想要添加一个数据库以及一个自动清空当前数据功能。

厌倦1997

我在excel表格中设计了一个送货单模板，但是不会添加vb不知道如何将送货单中的数据从sheet1放到sheet2中。并且通过vb尝试清空表内数据也会出现崩溃。

熊之召唤术

Sub ceshi()
    database = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;IMEX=1;HDR=YES';Data Source=" & ThisWorkbook.FullName
    Dim conn
    Set conn = CreateObject("adodb.connection")
   
    conn.Open database
    Sql = "select * from [Sheet1$C5:I17]"
    Worksheets("sheet2").Range("a6555").End(xlUp).CopyFromRecordset conn.Execute(Sql)
    conn.Close
    Set conn = Nothing
   
End Sub

熊之召唤术

代码我已经贴上来了，在审核，由于你预设了公式，在数据库SELECT前可能还需要加判断，不然会把空行复制到后面去

microyip

先从简单的基础学起，不要一步想飞天。

iwangyi

Sub BC()
n = Sheet2.Range("A65536").End(xlUp).Row
If Cells(3, "h") = Sheet2.Cells(n - 1, 1) Then MsgBox "已保存": Exit Sub
rl = Range("b18").End(xlUp).Row
X = 12 - rl
With Sheet2
Cells(3, "h").Copy .Cells(n + 1, "a").Resize(X)     '复制编号
Cells(4, "d").Copy .Cells(n + 1, "b").Resize(X)     '复制客户名
Cells(4, "i").Copy .Cells(n + 1, "c").Resize(X)     '复制送货日期
Cells(6, "c").Resize(X, 6).Copy .Cells(n + 1, "d")  '复制清单
Cells(19, "C").Copy .Cells(n + 1, "k").Resize(X)    '复制地址
Cells(19, "E").Copy .Cells(n + 1, "l").Resize(X)    '复制电话
Cells(21, "C").Copy .Cells(n + 1, "m").Resize(X)    '复制送货单位及经手人
Cells(21, "G").Copy .Cells(n + 1, "n").Resize(X)    '复制收货单位及经手人
End With
End Sub
关于清除开单内容，自己学者做  cells()=""

厌倦1997

iwangyi 发表于 2018-7-28 09:09
Sub BC()
n = Sheet2.Range("A65536").End(xlUp).Row
If Cells(3, "h") = Sheet2.Cells(n - 1, 1) Then M ...

好。谢谢您了我去试试看。

iwangyi

从录入窗体向记录的转化过程

厌倦1997

熊之召唤术 发表于 2018-7-27 23:26
代码我已经贴上来了，在审核，由于你预设了公式，在数据库SELECT前可能还需要加判断，不然会把空行复制到后 ...

好的。谢谢您

厌倦1997

iwangyi 发表于 2018-7-28 09:09
Sub BC()
n = Sheet2.Range("A65536").End(xlUp).Row
If Cells(3, "h") = Sheet2.Cells(n - 1, 1) Then M ...

请问一下我找到了一个模板
Sub zz()  ' 保存数据
    Dim ar(1 To 8, 1 To 9)
    If [g3] = "" Or [aa3] = "" Or [p15] = "" Then
        MsgBox "订货单位、送货日期和送货人必须全部填写完整方可保存数据。"
        Exit Sub
    End If
    ar(1, 1) = [aa3]
    For i = 5 To 12
        If Cells(i, 5) <> "" Then
            m = m + 1
            ar(m, 2) = [g3]: ar(m, 3) = Cells(i, "e"): ar(m, 4) = Cells(i, "p"): ar(m, 5) = Cells(i, "r")
            ar(m, 6) = Cells(i, "u"): ar(m, 7) = Cells(i, "x"): ar(m, 8) = Cells(i, "ab")
            ar(m, 9) = [p15]
        End If
    Next
    Sheet3.Range("B" & Sheet3.[c65536].End(3).Row + 1).Resize(m, 9) = ar
End Sub
这样子如果想要嵌套进我的表格中需要怎么办。