標題: 發問∶請各位高手指導修正 [打印本頁]

---

作者: eric093    時間: 2014-1-24 20:52     標題: 發問∶請各位高手指導修正

請各位指導一下我哪寫錯了--------

在二份資料中(以相同工作頁為例)比對客戶編號與下單者同時符合時，在第一份資料符合資料的欄位將第二份資料的配送地回寫！

例如：客戶編踸22888060是王大二下單的，比對符合後，就將配送地-台北回寫在  第一份資料的王大二 欄位後面！


客戶編號        訂單編號           公司          下單者                        客戶編號        下單者        配送地
22888060        106917613   大勝貿易           王大二         台北                         22888060        陳甲子        新竹
23659070        106917615   來來行           陳甲子                                  22888060        王大二        台北
                                                23659070        林中中        台中
                                                23659070        陳甲子        台南

Sub aa()

Dim rng(1 To 6), E As Range

Set rng(1) = Sheets(1).Range("A2")
Set rng(2) = Sheets(1).Range("G:G")
Set rng(3) = Sheets(1).Range("H:H")
Do While rng(1) <> ""

Set rng(3) = rng(2).Find(rng(1), lookat:=xlWhole)

If Not rng(3) Is Nothing Then
  
        Set rng(4) = rng(2).Offset(, 1)
        For Each E In rng(4)
            If rng(1) = E Then
               rng(1).Offset(, 4).Value = E.Offset(, 1)
             End If
         Next
   End With
End If

            
  
'
'
Loop

End Sub

---

作者: GBKEE    時間: 2014-1-25 08:07

回復 1# eric093
試試看

1. Option Explicit
   
2. Sub aa()
   
3. Dim Rng(1 To 4), E As Range
   
4. Set Rng(1) = Sheets(1).Range("A2")
   
5. 'Set Rng(2) = Sheets(1).Range("G:G") '範圍大(整欄)相對跑迴圈時間長
   
6. Set Rng(2) = Sheets(1).Range("G2", Sheets(1).Range("G2").End(xlDown)) '範圍小(有資料的整欄)
   
7. Do While Rng(1) <> ""
   
8.     Set Rng(3) = Rng(2).Find(Rng(1), lookat:=xlWhole)
   
9.     If Not Rng(3) Is Nothing Then
   
10.         For Each E In Rng(2)             '所有客戶編號中跑迴圈
    
11.             If Rng(1) = E And Rng(1).Offset(, 3) = E.Offset(, 1) Then '下單者相同
    
12.                Rng(1).Offset(, 4).Value = E.Offset(, 2)
    
13.              End If
    
14.          Next
    
15.     End If
    
16.     Set Rng(1) = Rng(1).Offset(1)
    
17. Loop
    
18. End Sub
    
19. Sub Ex()
    
20.     Dim Rng(1 To 3) As Range, E As Range
    
21.     Set Rng(1) = Sheets(1).Range("A2")
    
22.     Set Rng(2) = Sheets(1).Range("G:G")
    
23.     Do While Rng(1) <> ""
    
24.         Set Rng(3) = Rng(2).Find(Rng(1), lookat:=xlWhole)
    
25.         If Not Rng(3) Is Nothing Then
    
26.             With Rng(2)
    
27.                 .Replace Rng(1), "=5/0"     '相同客戶編號更換為錯誤值
    
28.                 With .SpecialCells(xlCellTypeFormulas, xlErrors)  '錯誤值的範圍
    
29. 
    
30.                     For Each E In .Cells    '僅相同客戶編號中跑迴圈
    
31.                         If E.Offset(, 1) = Rng(1).Offset(, 3) Then Rng(1).Offset(, 4) = E.Offset(, 2)
    
32.                         '下單者相同
    
33.                     Next
    
34.                 .Value = Rng(1)             '錯誤值改回為客戶編號
    
35.                 End With
    
36.             End With
    
37.         End If
    
38.         Set Rng(1) = Rng(1).Offset(1)
    
39.     Loop
    
40. End Sub

複製代碼

---

作者: eric093    時間: 2014-1-25 21:22

本帖最後由 eric093 於 2014-1-25 21:25 編輯

回復 2# GBKEE


    感謝，測試 ok ！

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)