每组数量不同的分组问题

SiGre

我现在有三列数据，要根据A列分组，每一列数据的个数不同。我曾经问过类似的问题（但是那次分组变量是数字），所以按照大神的方法自己改了之前的代码，以下，然后运行不成功

有别的方法可以解决也行。谢谢大家的帮助

1. Sub 宏1()
   
2. 
   
3. 
   
4. 
   
5. 
   
6. Dim conn As Object
   
7. 
   
8.     Dim sql As String, PathStr As String
   
9. PathStr = ThisWorkbook.FullName
   
10. 
    
11.    Set conn = CreateObject("ADODB.Connection")
    
12. 
    
13.    Select Case Application.Version * 1
    
14. 
    
15.    Case Is <= 11
    
16. 
    
17.       conn.ConnectionString = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
    
18. 
    
19.   Case Is >= 12
    
20. 
    
21.       conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    
22. 
    
23.     End Select
    
24. 
    
25.    conn.Open
    
26. 
    
27.    myrow = Sheet1.Range("A65536").End(xlUp).Row
    
28. 
    
29.    For Each i In Sheet2.Range("A2:A68")
    
30.      sql = "select * from [Sheet1$A1:c" & myrow & "] where 曲线名称=" & i
    
31. 
    
32.        Sheet1.Range("XFD2").End(xlToLeft).Offset(0, 5).CopyFromRecordset conn.Execute(sql)
    
33. 
    
34.     Next
    
35. 
    
36.    conn.Close
    
37.         
    
38.         
    
39.      End Sub
    

复制代码

SiGre

没有浏览量，自己顶一下

vbee

1. Sub 宏1()
   
2. Dim conn As Object
   
3.     Dim sql As String, PathStr As String
   
4. PathStr = ThisWorkbook.FullName
   
5.    Set conn = CreateObject("ADODB.Connection")
   
6.    Select Case Application.Version * 1
   
7.    Case Is <= 11
   
8.       conn.ConnectionString = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
   
9.   Case Is >= 12
   
10.       conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=Yes"";"""
    
11.     End Select
    
12.    conn.Open
    
13.    myrow = Sheet1.Range("A65536").End(xlUp).Row
    
14.    For Each C In Sheet2.Range("A2:A68")
    
15.      sql = "select * from [Sheet1$A1:E" & myrow & "] where 曲线名称='" & C & "'"
    
16.        Sheet1.Range("XFD2").End(xlToLeft).Offset(0, 2).CopyFromRecordset conn.Execute(sql)
    
17.     Next
    
18.    conn.Close
    
19.    Set cnn = Nothing
    
20. End Sub

复制代码

SiGre

我不知道怎么设置已解决，我的问题总之已经解决了。谢谢大神！