根据条件查找数据的问题

LMY123

LMY123 发表于 2017-9-19 19:29
SQL强度评定

补充内容 (2018-7-28 17:41):

1. Sub ADO批量评定复习()
   
2.     Set cnn = CreateObject("adodb.connection")
   
3.     Set rs = CreateObject("adodb.Recordset")
   
4.     Application.ScreenUpdating = False
   
5.     Application.DisplayAlerts = False
   
6.     For Each sh In Sheets
   
7.         If sh.Name <> "名册表" And sh.Name <> "表模" Then
   
8.             sh.Delete
   
9.         End If
   
10.     Next
    
11.     Application.DisplayAlerts = True
    
12.     cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
    
13.     sql = "select distinct 配合比编号 from [名册表$] where 配合比编号 is not null"
    
14.     Set rs = cnn.Execute(sql)
    
15.     brr = cnn.Execute(sql).getRows
    
16.     cnn.Close
    
17.     cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
    
18.     For x = 0 To UBound(brr, 2)
    
19.         Sheets.Add after:=Sheets(Sheets.Count)
    
20.         Sheets(2).Rows("1:157").Copy [a1]
    
21.         Sheets(2).Columns("A:T").Copy [a1]
    
22.         ActiveSheet.Name = brr(0, x)
    
23.         sql = "select 抗压强度 from [名册表$] where 配合比编号='" & brr(0, x) & "'"
    
24.         Set rs = CreateObject("adodb.Recordset")
    
25.         rs.Open sql, cnn, 1, 1
    
26.         ActiveSheet.UsedRange.Offset(15).ClearContents
    
27.         If rs.RecordCount > 0 Then
    
28.             ReDim crr(1 To rs.RecordCount, 1 To 20)
    
29.             For i = 1 To rs.RecordCount
    
30.                 m = Int((i - 1) / 10) + 1
    
31.                 j = i Mod 10
    
32.                 If j = 0 Then j = 10
    
33.                 crr(m, (j - 1) * 2 + 1) = rs.Fields(0).Value
    
34.                 rs.MoveNext
    
35.             Next i
    
36.             [a16].Resize(m, 20) = crr
    
37.         Else
    
38.             MsgBox "没有查到", vbInformation
    
39.         End If
    
40.     Next x
    
41.     Set rs = Nothing
    
42.     Set cnn = Nothing
    
43.     Application.ScreenUpdating = True
    
44. End Sub

复制代码