模板一键生成请教-VBA

SZ@HK123

麻烦老师们帮忙看看，感谢~

附件工作簿有4个工作表
1.仓库整理是数据源表
2.派送表整理-模板是需要一键生成的表
3.是想要的结果表
地区V也是属于数据源

简七

对表1数据做了部分整理,取消了合并单元格和上方空行

简七

1. Sub demo()
   
2.     Dim conn As Object, connectionStr$, sqlStr$
   
3.     Set conn = CreateObject("Adodb.Connection")
   
4.     connectionStr = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='excel 12.0;HDR=YES';Data Source=" & ThisWorkbook.FullName
   
5. 
   
6.     conn.Open connectionStr
   
7.    
   
8.     sqlStr = "SELECT" & _
   
9.             "   '' AS 司機," & _
   
10.             "   '' AS 跟車," & _
    
11.             "   '' AS 車牌," & _
    
12.             "   '' AS 客戶," & _
    
13.             "   '' AS 取貨點," & _
    
14.             "   A.收货公司名称 AS 送貨點," & _
    
15.             "   B.地區," & _
    
16.             "   (CSTR(A.[出货数量-托盘])+'板') AS 板," & _
    
17.             "   '' AS 箱," & _
    
18.             "   (CSTR(A.毛重KG)+'kg') AS 重量," & _
    
19.             "   '' AS  BM," & _
    
20.             "   A.发票号 AS 單號," & _
    
21.             "   A.特殊派送要求 AS [時間要求/注意事項]," & _
    
22.             "   ''," & _
    
23.             "   IIF(A.收货公司名称='德迅空','拆板,按箱交货','') AS 特別收費,"
    
24.     sqlStr = sqlStr & _
    
25.             "   '' AS OB," & _
    
26.             "   (FORMAT(NOW,'m/dd')+' '+ A.香港车牌) AS 中港車牌," & _
    
27.             "   '' AS 代墊雜費," & _
    
28.             "   ''," & _
    
29.             "   A.车次," & _
    
30.             "   A.大陆车牌 " & _
    
31.             "FROM" & _
    
32.             "   [1.仓库整理$] A," & _
    
33.             "   (SELECT DISTINCT A1.收货公司名称,A2.地區 FROM [1.仓库整理$] A1 LEFT JOIN [地区V$] A2 ON A1.收货公司名称=A2.收貨人) B " & _
    
34.             "WHERE" & _
    
35.             "   A.收货公司名称=B.收货公司名称"
    
36. 
    
37.     Application.ScreenUpdating = False
    
38.     Application.DisplayAlerts = False
    
39.     Dim useRange As Range
    
40.    
    
41.     With ThisWorkbook.Worksheets.Add(after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
    
42.         .Name = "生成模板" & Format(Now, "yymmddhhmmss")
    
43.         .Range("c3").CopyFromRecordset conn.Execute(sqlStr)
    
44.         .Range("c2:w2").Value = Array("司機", "跟車", "車牌", "客戶", "取貨點", "送貨點", "地區", "板", "箱", "重量", " BM", "單號", "時間要求/注意事項", "時間要求/注意事項", "特別收費", "OB", "中港車牌", "代墊雜費", "", "", "")
    
45.         .Range("e1").Value = "L每日派送"
    
46.         .Range("l1:m1").Value = Array("日期：", Format(Date + 1, "yyyy/mm/dd"))
    
47.         Set useRange = Application.Intersect(.UsedRange, .Range("2:1048576"))
    
48.     End With
    
49.     With useRange
    
50.         .Borders.Weight = xlThin
    
51.         .Borders.LineStyle = xlContinuous
    
52.         .Borders.ColorIndex = xlColorIndexAutomatic
    
53.         .HorizontalAlignment = xlHAlignLeft
    
54.         .VerticalAlignment = xlVAlignCenter
    
55.         .Font.Name = "微软雅黑"
    
56.         .Font.Size = 10
    
57.         .Font.Bold = True
    
58.         .Columns.AutoFit
    
59.     End With
    
60.     conn.Close
    
61.     Set conn = Nothing
    
62.    
    
63.     Application.DisplayAlerts = True
    
64.     Application.ScreenUpdating = True
    
65. End Sub
    

复制代码

SZ@HK123

简七 发表于 2023-5-18 10:55

谢谢老师呀！！！！把代码复制到工作表里面运行，不成功


点击调试就调到这句代码，麻烦帮忙看看
.Range("c3").CopyFromRecordset conn.Execute(sqlStr)

简七

SZ@HK123 发表于 2023-5-18 11:37
谢谢老师呀！！！！把代码复制到工作表里面运行，不成功

表1数据格式有问题。表1数据把所有单元格格式设置为常规

SZ@HK123

简七 发表于 2023-5-18 12:41
表1数据格式有问题。表1数据把所有单元格格式设置为常规

感谢老师！！！！
可以了，但是我这边的排序有问题，不是按照原本的排序，生成模板，顺序变了，麻烦老师再帮忙看看~

简七

在SQL语句后面加一句 ORDER BY A.车次

SZ@HK123

简七 发表于 2023-5-19 12:21
在SQL语句后面加一句 ORDER BY A.车次

感谢老师的帮助，祝一切顺利

peter-chen

thanks for share for study