|
|
楼主 |
发表于 2018-9-3 14:13
|
显示全部楼层
谢谢，两位大侠的回复，其中，试了一下，ISdongjh大侠的SQL方法，成功！，做成模版了，
但做了一些修改，解决了行数多于65000行的报错问题。
就是SQL取值时，不指定行数
【strSQL = "SELECT 单号 " & _
"FROM [" & strShName & "$]" & _】
我是野路子，虽然能用，还是希望请大侠指正一下
【1】附上文件
连单查询模版2.rar
(280.12 KB, 下载次数: 7)
【2】附上修改后的文件界面
【3】附上代码：
————————————————
Function Test(strStyleID As String)
Dim shSource As Worksheet, strShName As String
Dim lngRows As Long, arr As Variant, strFindID As String
Dim Conn As Object, Rst As Object, strPath As String
Dim strConn As String, strSQL As String
Dim rg As Range
Dim lngSumSala As Long '销量
Dim lngCountSala As Long '销售单数
Dim lngSameSala As Long '同单数
Dim arrResult(1 To 1, 1 To 4) As Variant
Dim myt
myt = Timer
strShName = "Sheet1" '工作表名
Set shSource = Sheets(strShName) 'shSoure 成为工作表
Set rg = shSource.Range("H2") 'rg 成为目标款号的所在的单元格
lngRows = shSource.Range("A" & Rows.Count).End(xlUp).Row 'lngRows 数据源A列行数
Set Conn = CreateObject("ADODB.Connection") '以打开的数据EXCEL表为源,建立外部数据连接
Set Rst = CreateObject("ADODB.Recordset")
strPath = ThisWorkbook.FullName
Select Case Application.Version * 1
Case Is <= 11
strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & strPath
Case Is >= 12
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strPath & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
End Select
'MsgBox SRCONN
Conn.Open strConn
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'统计单数情况
strSQL = "SELECT 单号 " & _
"FROM [" & strShName & "$]" & _
"WHERE 款号 = '" & strStyleID & "' " & _
"GROUP BY 款号, 单号"
'MsgBox strSQL
Rst.Open strSQL, Conn, 3, 1
'如果有单号，则将单号写入查询 变量
lngCountSala = Rst.RecordCount '将查询款号的总单数写入lngCountSala
If lngCountSala > 0 Then
arr = Rst.getrows '查询结果写入数组arr
arr = Application.WorksheetFunction.Index(arr, 1, 0) '将ARR第一行用index方式写入ARR? 为什么要这句
strFindID = "'" & Join(arr, "','") & "'" '将ARR写入strFindID,成"单号1,单号2,...",作下面统行单号的条件
Rst.Close
Else
'没有单号，退出
Set Rst = Nothing
Set Conn = Nothing
Exit Function
End If
'MsgBox "1~~" & (Timer - myt)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'统计销量
strSQL = "SELECT Sum([数量]) AS 合计 " & _
"FROM [" & strShName & "$]" & _
"WHERE 款号='" & strStyleID & "';"
If Rst.State = 1 Then Rst.Close
Rst.Open strSQL, Conn, 3, 1
lngSumSala = Rst.Fields("合计") '将查询款号的销售总量写入 lngSumSala
Rst.Close
'MsgBox "2~~" & (Timer - myt)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'统计同单数
strSQL = "SELECT 单号, Count(款号) AS 款号之计数 " & _
"FROM (SELECT 单号, 款号 " & _
"FROM [" & strShName & "$]" & _
"WHERE (单号) In (" & strFindID & ") " & _
"GROUP BY 单号, 款号) " & _
"GROUP BY 单号 " & _
"HAVING Count(款号) >1 ;"
If Rst.State = 1 Then Rst.Close
Rst.Open strSQL, Conn, 3, 1
lngSameSala = Rst.RecordCount '将查询款号的同单数写入 lngSameSala
'如果有同单号，则将单号写入查询 变量
If lngSameSala > 0 Then
arr = Rst.getrows
arr = Application.WorksheetFunction.Index(arr, 1, 0) '将ARR第一行用index方式写入ARR，只要单号
strFindID = "'" & Join(arr, "','") & "'" '将ARR写入strFindID,成"单号1,单号2,...",作下面统行单号的条件
Rst.Close
Else
'没有单号，退出
Set Rst = Nothing
Set Conn = Nothing
Exit Function
End If
'MsgBox "3~~" & (Timer - myt)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
arrResult(1, 1) = lngSumSala '将目标款号销售总数写入数组arrResult的第1列
arrResult(1, 2) = lngCountSala '将目标款号总单数写入数组arrResult的第2列
arrResult(1, 3) = lngSameSala '将目标款号同款单数写入数组arrResult的第3列
arrResult(1, 4) = Round((lngSameSala / lngCountSala) * 100, 2) & "%" '将目标款号连带率写入数组arrResult的第2列
shSource.Range("I2").Resize(1, 4) = arrResult '将数组写入汇总单元格
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'统计同单款号情况
strSQL = "SELECT [款号],Count([单号]) AS 计数, (round((Count([单号])/" & lngCountSala & ")*100,2 ) & '%' ) AS 同单率 " & _
"FROM (SELECT 单号, 款号 " & _
"FROM [" & strShName & "$] " & _
"WHERE 单号 In (" & strFindID & ") And 款号<>'" & strStyleID & "' " & _
"GROUP BY 单号, 款号) " & _
"GROUP BY [款号] " & _
"ORDER BY Count([单号]) DESC;"
If Rst.State = 1 Then Rst.Close
Rst.Open strSQL, Conn, 3, 1
MsgBox "4~~" & (Timer - myt)
'MsgBox Rows.Count & "-" & rg.Row
'rg.Resize(Rows.Count - rg.Row, 3).ClearContents ''将目标款号所在单元素的第二行起写入查询结果
Range("H5:J105").ClearContents
Range("H5:J105").CopyFromRecordset Rst
Set Rst = Nothing
Set Conn = Nothing
End Function
————————————————————————————————
sheet1:
_______________________________
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$H$2" Then Exit Sub
If Target.Value <> "" Then
Application.ScreenUpdating = False
Application.Cursor = xlWait
Application.EnableEvents = False
Test Target.Value
Application.ScreenUpdating = True
Application.Cursor = xlDefault
Application.EnableEvents = True
End If
End Sub
|
|
楼主: andyleeq
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2018-9-3 13:54
