發問∶請各位高手指導修正

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

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

例如：客戶編踸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

測試.rar (5.97 KB)

樓主熱帖

新人一枚

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2014-1-25 08:07 | 只看該作者

回復 1# eric093
試試看

Option Explicit
Sub aa()
Dim Rng(1 To 4), E As Range
Set Rng(1) = Sheets(1).Range("A2")
'Set Rng(2) = Sheets(1).Range("G:G") '範圍大(整欄)相對跑迴圈時間長
Set Rng(2) = Sheets(1).Range("G2", Sheets(1).Range("G2").End(xlDown)) '範圍小(有資料的整欄)
Do While Rng(1) <> ""
Set Rng(3) = Rng(2).Find(Rng(1), lookat:=xlWhole)
If Not Rng(3) Is Nothing Then
For Each E In Rng(2) '所有客戶編號中跑迴圈
If Rng(1) = E And Rng(1).Offset(, 3) = E.Offset(, 1) Then '下單者相同
Rng(1).Offset(, 4).Value = E.Offset(, 2)
End If
Next
End If
Set Rng(1) = Rng(1).Offset(1)
Loop
End Sub
Sub Ex()
Dim Rng(1 To 3) As Range, E As Range
Set Rng(1) = Sheets(1).Range("A2")
Set Rng(2) = Sheets(1).Range("G:G")
Do While Rng(1) <> ""
Set Rng(3) = Rng(2).Find(Rng(1), lookat:=xlWhole)
If Not Rng(3) Is Nothing Then
With Rng(2)
.Replace Rng(1), "=5/0" '相同客戶編號更換為錯誤值
With .SpecialCells(xlCellTypeFormulas, xlErrors) '錯誤值的範圍
For Each E In .Cells '僅相同客戶編號中跑迴圈
If E.Offset(, 1) = Rng(1).Offset(, 3) Then Rng(1).Offset(, 4) = E.Offset(, 2)
'下單者相同
Next
.Value = Rng(1) '錯誤值改回為客戶編號
End With
End With
End If
Set Rng(1) = Rng(1).Offset(1)
Loop
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

eric093

中學生 Rank: 2

帖子: 77
主題: 30
精華: 0
積分: 110
點名: 0
作業系統: win7
軟體版本: office2003
閱讀權限: 20
性別: 男
來自: 台北
註冊時間: 2013-7-14
最後登錄: 2018-10-3

3^#

發表於 2014-1-25 21:22 | 只看該作者

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

回復 2# GBKEE

感謝，測試 ok ！

新人一枚

TOP