求助，请教老师，VBA实现条件筛选并复制数据到指定位置

超级soap

请教老师。
在sheet”订单录入“录入订单信息，在”录入数据“中录入生产数据。需要对比两个sheet中的数据，当订单号、规格、轮型、计划长度相同时，将”订单录入“中的计划件数填写到”录入数据“中相对应的单元格中。
对于订单录入中没有的，在录入数据中将单元格填充红色。

求帮助，在线等。
感谢各位！

超级soap

求助啊各位老师！

诱儿元

Sub t()
   
    Dim cnn As New Connection, SQL$, rs As New ADODB.Recordset, arr
    Set cnn = CreateObject("adodb.connection")
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName
    If cnn.State <> 1 Then
        MsgBox "未能成功连接数据库！", vbCritical + vbOKOnly, "警告"
        Exit Sub
        
    End If
    SQL = "select 订单号,规格,轮型,计划长度 from [录入数据$] where 订单号<>'' or 订单号 is not null"
    arr = cnn.Execute(SQL).GetRows
   
    For i = 0 To UBound(arr, 2)
        SQL = "select * from [订单录入$] where 订单号='" & arr(0, i) & "' and 规格='" & arr(1, i) & "' and 轮型='" & arr(2, i) & "' and 计划长度='" & arr(3, i) & "'"
        rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
        If rs.RecordCount = 0 Then
            Sheets("录入数据").Range(Cells(i + 2, 1), Cells(i + 2, 15)).Interior.Color = 255
        End If
        rs.Close
    Next
   
    SQL = "update [录入数据$] a,[订单录入$] b set a.计划件数=b.计划件数 where (a.订单号<>'' or a.订单号 is not null)" & _
            " and a.订单号=b.订单号 and a.规格=b.规格 and a.轮型=b.轮型 and a.计划长度=b.计划长度"
    cnn.Execute SQL
   
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
   
   
   
        

End Sub

诱儿元

工程需要引用 microsoft activeX data objects

诱儿元

诱儿元 发表于 2018-5-23 17:03
工程需要引用 microsoft activeX data objects

当工作表录入数据为空时，会报错

Sub t()
   
    Dim cnn As New Connection, SQL$, rs As New ADODB.Recordset, arr
    Set cnn = CreateObject("adodb.connection")
    cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName
    If cnn.State <> 1 Then
        MsgBox "未能成功连接数据库！", vbCritical + vbOKOnly, "警告"
        Exit Sub
        
    End If
    SQL = "select 订单号,规格,轮型,计划长度 from [录入数据$] where 订单号<>'' or 订单号 is not null"
    arr = cnn.Execute(SQL).GetRows
   
    For i = 0 To UBound(arr, 2)
        SQL = "select * from [订单录入$] where 订单号='" & arr(0, i) & "' and 规格='" & arr(1, i) & "' and 轮型='" & arr(2, i) & "' and 计划长度='" & arr(3, i) & "'"
        rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
        If rs.RecordCount = 0 Then
            Sheets("录入数据").Range(Cells(i + 2, 1), Cells(i + 2, 15)).Interior.Color = 255
        End If
        rs.Close
    Next
   
    SQL = "update [录入数据$] a,[订单录入$] b set a.计划件数=b.计划件数 where (a.订单号<>'' or a.订单号 is not null)" & _
            " and a.订单号=b.订单号 and a.规格=b.规格 and a.轮型=b.轮型 and a.计划长度=b.计划长度"
    cnn.Execute SQL
   
    cnn.Close
    Set rs = Nothing
    Set cnn = Nothing
   
   
   
        

End Sub

诱儿元

1. Sub t()
   
2.     Dim cnn As New Connection, SQL$, rs As New ADODB.Recordset, arr
   
3.     Set cnn = CreateObject("adodb.connection")
   
4.     cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.FullName
   
5.     If cnn.State <> 1 Then
   
6.         MsgBox "未能成功连接数据库！", vbCritical + vbOKOnly, "警告"
   
7.         Exit Sub
   
8.         
   
9.     End If
   
10.     SQL = "select 订单号,规格,轮型,计划长度 from [录入数据$] where 订单号<>'' or 订单号 is not null"
    
11.     arr = cnn.Execute(SQL).GetRows
    
12.    
    
13.     For i = 0 To UBound(arr, 2)
    
14.         SQL = "select * from [订单录入$] where 订单号='" & arr(0, i) & "' and 规格='" & arr(1, i) & _
    
15.         "' and 轮型='" & arr(2, i) & "' and 计划长度='" & arr(3, i) & "'"
    
16.         rs.Open SQL, cnn, adOpenKeyset, adLockOptimistic
    
17.         If rs.RecordCount = 0 Then
    
18.             Sheets("录入数据").Range(Cells(i + 2, 1), Cells(i + 2, 15)).Interior.Color = 255
    
19.         End If
    
20.         rs.Close
    
21.     Next
    
22.    
    
23.     SQL = "update [录入数据$] a,[订单录入$] b set a.计划件数=b.计划件数 where (a.订单号<>'' or a.订单号 is not null)" & _
    
24.             " and a.订单号=b.订单号 and a.规格=b.规格 and a.轮型=b.轮型 and a.计划长度=b.计划长度"
    
25.     cnn.Execute SQL
    
26.    
    
27.     cnn.Close
    
28.     Set rs = Nothing
    
29.     Set cnn = Nothing
    
30. 
    
31. End Sub

复制代码

诱儿元

图片需要审核吗

超级soap

诱儿元 发表于 2018-5-23 17:10
图片需要审核吗

谢谢老师，大体思路是把订单录入这个sheet作为SQL数据库的数据源，然后用操作SQL的思路来实现对比对吗？

超级soap

诱儿元 发表于 2018-5-23 17:03
工程需要引用 microsoft activeX data objects

还有一个问题想请教，我的开发环境是WIN10  OFFICE2016，但使用环境是WIN7  OFFICE2007，这个在引用的时候有什么区别吗？

诱儿元

引用个低版本的，一般没啥事