销售数据按客户查询和按单号查询的代码有问题

wulin588

各位老师，大家好！ 本人新手，不太会用VBA，有个表格也是从本论坛得来的，现有销售数据按客户查询和按单号查询的代码有问题，请好心人帮忙修改下，谢谢！跪求大神帮忙！

wulin588

请各位大师帮帮忙，谢谢！

毛利的乖乖熊

能否举两个实际问题例子，哪里不对 ？

zhjlgaojuan

Public Sub ??????()
Dim sql As String, mycnn As Object, myData As Object
Dim CX
Set mycnn = CreateObject("ADODB.connection")
Set myData = CreateObject("adodb.recordset")
mycnn.Open ("provider=Microsoft.ACE.OLEDB.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.FullName)
sql = "select ???????,????,????,???,???,???,???????,???,????,????,??λ,??????λ????,????,????,???,??? from  [???????$E4:W" _
    & Sheets("???????").UsedRange.Rows.Count & "]  where ???????='" & Sheets("??????").[o1].Value & "'"
myData.Open sql, mycnn, 1, 3
If myData.RecordCount > 0 Then
    CX = myData.getrows()
    With Sheets("??????")
        .[g1] = CX(0, 0)
        .[p1] = CX(1, 0)
        .[g16] = CX(2, 0)
        .[j16] = CX(3, 0)
        .[l16] = CX(4, 0)
        .[h14] = CX(5, 0)
        .Range("f5:p12").ClearContents
        For i = 0 To UBound(CX, 2)
            .Range(Chr(70 + i) & 5 + i) = i + 1
            For j = 1 To 10
            .Range(Chr(70 + j) & 5 + i) = CX(j + 5, i)
            Next
        Next
    End With
Else
    MsgBox "δ?鵽???????!"
End If
myData.Close
mycnn.Close
Set myData = Nothing
Set mycnn = Nothing
End Sub

一指禅62

重写了，自己比对吧

1. Sub 查询_客户明细()
   
2.     Dim arr, i&, j%, a(), n&
   
3.     Dim Sh As Worksheet, key$, t1 As Date, t2 As Date
   
4.     Set Sh = Sheets("客户查询")
   
5.     key = Sh.Range("C2"): t1 = Sh.Range("G2"): t2 = Sh.Range("J2")
   
6.     arr = Sheets("销售明细").Range("E4").CurrentRegion
   
7.     For i = 4 To UBound(arr)
   
8.         If arr(i, 19) = key And arr(i, 1) >= t1 And arr(i, 1) <= t2 Then
   
9.             n = n + 1: ReDim Preserve a(1 To 18, 1 To n)
   
10.             For j = 1 To 18
    
11.                 a(j, n) = arr(i, j)
    
12.             Next
    
13.         End If
    
14.     Next
    
15.     Application.ScreenUpdating = False
    
16.     Sh.Range("B5:S10000").ClearContents
    
17.     Sh.Range("B5:S10000").Borders.LineStyle = xlNone
    
18.     If n > 0 Then
    
19.         With Sh.Range("B5").Resize(n, 18)
    
20.             .Borders.LineStyle = xlContinuous
    
21.             .Value = WorksheetFunction.Transpose(a)
    
22.         End With
    
23.     Else
    
24.         MsgBox "没有找到相应数据！"
    
25.     End If
    
26.     Application.ScreenUpdating = True
    
27. End Sub
    
28. 
    
29. Sub 查询_销售单号()
    
30.     Dim arr, i&, j%, a(1 To 11, 1 To 8), n%, key$
    
31.     Sheets("单号查询").Select
    
32.     key = Range("O1")
    
33.     arr = Sheets("销售明细").Range("E4").CurrentRegion
    
34.     For i = 4 To UBound(arr)
    
35.         If arr(i, 2) = key Then
    
36.             n = n + 1
    
37.             a(1, n) = n
    
38.             For j = 4 To 13
    
39.                 a(j - 2, n) = arr(i, j)
    
40.             Next
    
41.         End If
    
42.     Next
    
43.     i = i - 1
    
44.     [h14] = arr(i, 14)
    
45.     [g16] = arr(i, 15)
    
46.     [j16] = arr(i, 16)
    
47.     [L16] = arr(i, 17)
    
48.     [O16] = arr(i, 18)
    
49.     [g2] = arr(i, 19)
    
50.     Range("F5:P12") = WorksheetFunction.Transpose(a)
    
51. End Sub

复制代码

一指禅62

有些小的变动，留意一下。

销售管理.rar (107.99 KB, 下载次数: 61)

2018-8-31 17:20 上传

点击文件名下载附件

wulin588

各位老师上午好！感谢你们的回复！感谢你们帮了我大忙，在此跪谢了！

wulin588

@一指禅62 老师：我按您的表格验算了下，有几个小问题，求您完善下，谢谢了
1.保存销售明细时，按2次保存时会重复保存，希望有提示“”已有此单单号，是否更新“，如选是更新后会覆盖已有的单号数据（如果不这样设置，按客户查询时重复的单号有会查不到）
2.单号查询表中，客户，日期，业务员制单审核客户签收没有变化

wulin588

wulin588 发表于 2018-9-1 10:29
@一指禅62 老师：我按您的表格验算了下，有几个小问题，求您完善下，谢谢了
1.保存销售明细时，按2次保存 ...

@一指禅62 老师：保存销售明细的代码，不是您写的，麻烦您完善下，谢谢！

wulin588

毛利的乖乖熊 发表于 2018-8-31 14:27
能否举两个实际问题例子，哪里不对 ？

那2个查询的功能不工作