[已解决]复制或提取数据

hwc2ycy · 发表于 2013-7-18 22:30

也可以的，但是可能会有BUG。
对于日期，数值字段时，处理方法略有不同了。

张雄友 · 发表于 2013-7-18 22:35

hwc2ycy 发表于 2013-7-18 22:30
也可以的，但是可能会有BUG。
对于日期，数值字段时，处理方法略有不同了。

像要查询工序号时，我改成以下这样，不行的，数值字段时

Const adUseClient = 3
Const adModeShareDenyWrite = 8
Const adModeReadWrite = 3
Const adModeRead = 1
Dim AdoConn As Object, AdoRst As Object
Sub 提取数据()
Dim sht As Worksheet
Dim strSql As String
Dim strCode As String
Dim lLastRow As Long
Dim arrTitle()
Dim i As Long
strCode = Application.InputBox("请输入要查找的工序号字段值" & vbCrLf & vbCrLf & "请注意大小写", Type:=2)
If strCode = "False" Then
MsgBox "没有输入查询字段或没有确定，结束"
Exit Sub
End If
For Each sht In Worksheets
With sht
If .Name <> "提取数据" Then
lLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
strSql = strSql & "select * from [" & sht.Name & "$A1:O" & lLastRow & "] where 工序号='" & strCode & "' union all "
End If
End With
Next
If Len(strSql) = 0 Then Exit Sub
strSql = Left(strSql, Len(strSql) - 9)
If ADOQuery(ThisWorkbook.FullName, strSql) Then
With Worksheets("提取数据")
Application.ScreenUpdating = False
.UsedRange.ClearContents
ReDim arrTitle(1 To AdoRst.Fields.Count)
For i = 1 To UBound(arrTitle)
arrTitle(i) = AdoRst.Fields(i - 1).Name
Next
.Range("a1").Resize(, UBound(arrTitle)).Value = arrTitle
If AdoRst.RecordCount > 0 Then
.Range("a2").CopyFromRecordset AdoRst
MsgBox "查询完毕" & vbCrLf & vbCrLf & "一共查询到 " & AdoRst.RecordCount & " 条记录", vbInformation + vbOKOnly
Else
MsgBox "没有查询到符合条件的数据" & vbCrLf & "请检查工序号字段"
End If
Application.ScreenUpdating = True
End With
End If
End Sub
Function ADOQuery(strFullname As String, Optional strSql As String, Optional blnHasHeader As Boolean = True) As Boolean
Dim StrConn$
Set AdoConn = CreateObject("ADODB.Connection")
StrConn = "Provider= Microsoft.Jet.OLEDB.4.0;" & _
"Data Source='" & strFullname & "';Extended Properties='Excel 8.0;HDR=" & blnHasHeader & ";imex=1';"
On Error GoTo ErrorHandler
With AdoConn
.CommandTimeout = 5
.ConnectionTimeout = 5
.CursorLocation = adUseClient
.Mode = adModeRead
.ConnectionString = StrConn
.Open
End With
Set AdoRst = AdoConn.Execute(strSql)
ADOQuery = True
Exit Function
ErrorHandler:
MsgBox Err.Number & vbCrLf & Err.Description
Set AdoRst = Nothing
Set AdoConn = Nothing
End Function

复制代码

hwc2ycy · 发表于 2013-7-18 22:49

本帖最后由 hwc2ycy 于 2013-7-18 22:50 编辑

原来strSql = Left(strSql, Len(strSql) - 11)的11是有用意的，你不要随便改。改了就出错了。
另外，数据型的话就要用LIKE来匹配了。

Sub 提取数据()
Dim sht As Worksheet
Dim strSql As String
Dim strCode As String
Dim lLastRow As Long
Dim arrTitle()
Dim i As Long
strCode = Application.InputBox("请输入要查找的工序号字段值" & vbCrLf & vbCrLf & "请注意大小写", Type:=2)
If strCode = "False" Then
MsgBox "没有输入查询字段或没有确定，结束"
Exit Sub
End If
For Each sht In Worksheets
With sht
If .Name <> "提取数据" Then
lLastRow = .Cells(Rows.Count, 1).End(xlUp).Row
strSql = strSql & "select * from [" & sht.Name & "$A1:O" & lLastRow & "] where 工序号 like '" & strCode & "' union all "
End If
End With
Next
If Len(strSql) = 0 Then Exit Sub
strSql = Left(strSql, Len(strSql) - 11)
If ADOQuery(ThisWorkbook.FullName, strSql) Then
With Worksheets("提取数据")
Application.ScreenUpdating = False
.UsedRange.ClearContents
ReDim arrTitle(1 To AdoRst.Fields.Count)
For i = 1 To UBound(arrTitle)
arrTitle(i) = AdoRst.Fields(i - 1).Name
Next
.Range("a1").Resize(, UBound(arrTitle)).Value = arrTitle
If AdoRst.RecordCount > 0 Then
.Range("a2").CopyFromRecordset AdoRst
MsgBox "查询完毕" & vbCrLf & vbCrLf & "一共查询到 " & AdoRst.RecordCount & " 条记录", vbInformation + vbOKOnly
Else
MsgBox "没有查询到符合条件的数据" & vbCrLf & "请检查工序号字段"
End If
Application.ScreenUpdating = True
End With
End If
End Sub

复制代码

张雄友 · 发表于 2013-7-18 22:58

hwc2ycy 发表于 2013-7-18 22:49
原来strSql = Left(strSql, Len(strSql) - 11)的11是有用意的，你不要随便改。改了就出错了。
另外，数据型 ...

出错的，3001类型。

hwc2ycy · 发表于 2013-7-18 23:04

你把上面定义的常量搞丢了，肯定要出错呀。

hwc2ycy · 发表于 2013-7-18 23:04

Const adUseClient = 3
Const adModeShareDenyWrite = 8
Const adModeReadWrite = 3
Const adModeRead = 1

复制代码

这几句要放在模块顶部。

hwc2ycy · 发表于 2013-7-18 23:05

Dim AdoConn As Object, AdoRst As Object

复制代码

还有这个模块级变量，放在常量声明下面

hwc2ycy · 发表于 2013-7-18 23:06

我自己测的时候都是没问题的。

张雄友 · 发表于 2013-7-18 23:13

hwc2ycy 发表于 2013-7-18 23:05
还有这个模块级变量，放在常量声明下面

原来strSql = Left(strSql, Len(strSql) - 11)的11是有用意的，

11不用改的？11表示什么？

hwc2ycy · 发表于 2013-7-18 23:15

这个最佳答案由 hwc2ycy 给出，感谢 hwc2ycy 的回答。

单击隐藏图章

生成的SQL语句时，最后的“ union all "是多余的，不需要，11个字符串。
所以用LEFT截取时要减掉11个。

		自动登录	找回密码
密码			注册