希望想通过VBA，将sheet2订单日期和车型，通过电话自动匹配填写，可以？

清@清

希望想通过VBA，将sheet2订单日期和车型，通过电话自动匹配填写，可以？

zax010

Sub zz()
    Dim d, ar
    Set d = CreateObject("Scripting.Dictionary")
    ar = Sheet2.Range("A1").CurrentRegion
    For i = 2 To UBound(ar)
        d(ar(i, 6)) = Array(ar(i, 1), ar(i, 5))
    Next
    For i = 2 To [a65536].End(3).Row
        Cells(i, "i").Resize(1, 2) = d(Cells(i, 3).Value)
    Next
End Sub

chxw68

1. Sub test()
   
2.   Dim r%, i%
   
3.   Dim arr, brr
   
4.   Dim d As Object
   
5.   Set d = CreateObject("scripting.dictionary")
   
6.   With Worksheets("sheet2")
   
7.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
8.     arr = .Range("a2:f" & r)
   
9.     For i = 1 To UBound(arr)
   
10.       d(arr(i, 6)) = Array(arr(i, 1), arr(i, 5))
    
11.     Next
    
12.   End With
    
13.   With Worksheets("sheet1")
    
14.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
15.     For i = 2 To r
    
16.       If d.exists(.Cells(i, 3).Value) Then
    
17.         .Cells(i, 9).Resize(1, 2) = d(.Cells(i, 3).Value)
    
18.       End If
    
19.     Next
    
20.   End With
    
21.         
    
22. End Sub
    

复制代码

chxw68

详见附件。

zax010

VBA.rar (16.84 KB, 下载次数: 10)

2017-7-22 20:07 上传

点击文件名下载附件

凌空一羽

此题直接用公式就行了
来个公式的吧……

1. =IFERROR(INDEX(Sheet2!A:A,MATCH(C2,Sheet2!F$1:F$7,)),"")

复制代码

1. =IFERROR(INDEX(Sheet2!E:E,MATCH(C2,Sheet2!F$1:F$7,)),"")

复制代码

凌空一羽

我也来个VBA吧……

1. Sub lkyy()
   
2. Set cnn = CreateObject("ADODB.Connection")
   
3. cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties='excel 12.0;hdr=yes;imex=1';data source=" & ThisWorkbook.FullName
   
4. Sql = "select b.订单日期,b.车型 from [Sheet1$A1:C]a left join [Sheet2$]b on a.联系方式=b.联系电话1 where a.日期 is not null"
   
5. Range("I2").CopyFromRecordset cnn.Execute(Sql)
   
6. cnn.Close
   
7. Set cnn = Nothing
   
8. End Sub

复制代码

清@清

凌空一羽 发表于 2017-7-22 20:42
此题直接用公式就行了
来个公式的吧……

您好！要是电话号码有重复，怎么提取数据啊