根据条件查找数据的问题

yuliangexcel · 发表于 2011-7-31 10:54

根据条件查找符合要求的数据，具体见附件。请解决，谢谢。

zhaogang1960 · 发表于 2011-7-31 11:58

数据源只有9列，查询要求10列，请说明这10列分别是什么？

yuliangexcel · 发表于 2011-7-31 12:21

这10列都是强度值

zhaogang1960 · 发表于 2011-7-31 12:48

请测试
Private Sub CommandButton1_Click()
Dim cnn As Object, rs As Object, SQL$, arr(), i&, j&, m&
Set cnn = CreateObject("adodb.connection")
cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties=Excel 8.0;data source=" & ThisWorkbook.FullName
SQL = "select 抗压强度 from [Sheet1$" & Sheets("Sheet1").[a1].CurrentRegion.Address(0, 0) & "] where 配合比编号='" & [N4] & "' and 供货时间 between #" & [N5] & "# and #" & [R5] & "#"
Set rs = CreateObject("adodb.Recordset")
rs.Open SQL, cnn, 1, 3
ReDim arr(1 To rs.RecordCount, 1 To 20)
For i = 1 To rs.RecordCount
      m = Int((i - 1) / 10) + 1
      j = i Mod 10
      If j = 0 Then j = 10
      arr(m, (j - 1) * 2 + 1) = rs.Fields(0).Value
      rs.MoveNext
Next
cnn.Close
Set cnn = Nothing
ActiveSheet.UsedRange.Offset(15).ClearContents
[a16].Resize(m, 20) = arr
End Sub

zhaogang1960 · 发表于 2011-7-31 12:51

请看附件

新建 Microsoft Excel 工作表.rar (52.5 KB, 下载次数: 68)

yuliangexcel · 发表于 2011-7-31 13:07

谢谢你了，我先测试一下。

yuliangexcel · 发表于 2011-7-31 18:14

当查询条件在数据源中不存在时，提示下标越界，版主再给改一下。

zhaogang1960 · 发表于 2011-7-31 18:20

原帖由 yuliangexcel 于 2011-7-31 18:14 发表
当查询条件在数据源中不存在时，提示下标越界，版主再给改一下。

Private Sub CommandButton1_Click()
Dim cnn As Object, rs As Object, SQL$, arr(), i&, j&, m&
Set cnn = CreateObject("adodb.connection")
cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties=Excel 8.0;data source=" & ThisWorkbook.FullName
SQL = "select 抗压强度 from [Sheet1$" & Sheets("Sheet1").[a1].CurrentRegion.Address(0, 0) & "] where 配合比编号='" & [N4] & "' and 供货时间 between #" & [N5] & "# and #" & [R5] & "#"
Set rs = CreateObject("adodb.Recordset")
rs.Open SQL, cnn, 1, 3
ActiveSheet.UsedRange.Offset(15).ClearContents
If rs.RecordCount > 0 Then
      ReDim arr(1 To rs.RecordCount, 1 To 20)
      For i = 1 To rs.RecordCount
         m = Int((i - 1) / 10) + 1
         j = i Mod 10
         If j = 0 Then j = 10
         arr(m, (j - 1) * 2 + 1) = rs.Fields(0).Value
         rs.MoveNext
      Next
      [a16].Resize(m, 20) = arr
Else
      MsgBox "没有查到", vbInformation
End If
cnn.Close
Set cnn = Nothing
End Sub

yuliangexcel · 发表于 2011-7-31 20:28

谢谢了，

。

LMY123 · 发表于 2017-9-19 19:29

SQL强度评定

补充内容 (2018-7-28 17:41):
Sub ADO批量评定复习()
Set cnn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.Recordset")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Fo...

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

[求助] 根据条件查找数据的问题

评分