兩個不同的工作表比對和新增

excel excel vba vba

art4444 2018-08-15 11:45:35 ‧ 5446 瀏覽

分享至

小弟有兩個工作表 "新下載資料" 和 "搜尋表"
新的資料會放入 "新下載資料"
舊的資料會放入 "搜尋表"

為了將新的資料與舊的資料進行比對
將新的資料在舊的資料(工作表)做新增的工作(更新)
故設計了一個VBA
由於小弟不是專業人才
因此想請高手們看看有沒有問題
或是有改進和討論的空間
以達到更精簡更有效率的目的... (如下)

Sub 新下載資料match()

 Dim LA As Long, LB As Long
 Dim k As Long, i As Long
 
 ActiveWorkbook.Worksheets("搜尋表").Select
 LA = Worksheets("搜尋表").Range("C500000").End(xlUp).Row
 
 ActiveWorkbook.Worksheets("新下載資料").Select
 LB = Worksheets("新下載資料").Range("C500000").End(xlUp).Row
 
 For i = 2 To LB
      Sheets("新下載資料").Select
      Cells(i, 2).Select
     
      If Cells(i,2).Value = "" Then Exit For
      
      For k = 2 To LA
           If ActiveCell.Formula = "=MATCH(Cells(i,2),Worksheets("搜尋表").Cells(k,2),0)" > 1 Then
                k=k+1
           Else
                Rows(i).Select
                Rows(i).Copy
                Sheets("搜尋表").Select
                ActiveSheet.Paste Rows(k+1)
           End If
      Next
 Next
 
 以上 ,感恩 !!! ^^

paicheng0111 iT邦大師 5 級 ‧ 2018-08-15 12:18:19 檢舉

你有試跑過嗎？

art4444 iT邦新手 5 級 ‧ 2018-09-07 10:49:38 檢舉

我試試看

art4444 iT邦新手 5 級 ‧ 2018-09-07 10:49:39 檢舉

我試試看

登入發表討論

直播研討會

{{ item.channelVendor }} {{ item.webinarstarted }} |

直播中

1 個回答

paicheng0111

iT邦大師 5 級 ‧ 2018-08-15 12:35:02

你有試跑過嗎？下面這段應該會發生錯誤。

If ActiveCell.Formula = "=MATCH(Cells(i,2),Worksheets("搜尋表").Cells(k,2),0)" > 1 Then

直接用match函數去比對即可。另外，從最後一筆之下寫入新資料。

Sub 新下載資料match()

    Dim LA As Long, LB As Long, old as range
    Dim k As Long, i As Long
 
    LA = Worksheets("搜尋表").cells(rows.count, 2).End(xlUp).Row
    set old = Worksheets("搜尋表").range(Worksheets("搜尋表").range("B2"), Worksheets("搜尋表").cells(LA, 2))
    LB = Worksheets("新下載資料").cells(rows.count, 2).End(xlUp).Row
    
 
    For i = 2 To LB
        With Worksheets("新下載資料").Cells(i, 2)
      
        If .Value = "" Then 
            Exit For
        Elseif iserror(application.match(.value, old ,0)) Then
            Worksheets("搜尋表").cells(rows.count, 2).end(xlup).offset(1).value = .value
        Else
        End If
        End with
    Next i
End Sub

回應 18
分享
檢舉

看更多先前的回應...收起先前的回應...

art4444 iT邦新手 5 級 ‧ 2018-08-15 16:07:18 檢舉

恩... 我也發現了~ 可是不知道該怎麼表示比較好... ="=a
選定的目標和範圍應該沒問題啊?
還是範圍不能這樣表示...

paicheng0111 iT邦大師 5 級 ‧ 2018-08-15 17:26:36 檢舉

能貼個圖來看看嗎？

paicheng0111 iT邦大師 5 級 ‧ 2018-08-16 10:51:04 檢舉

而且你寫的這個Match函數只比對Worksheets("搜尋表")的一個儲存格Cells(k,2)。
它的效果相當於

If cells(i,2).value = Worksheets("搜尋表").cells(k,2).value Then

art4444 iT邦新手 5 級 ‧ 2018-08-16 11:21:47 檢舉

art4444 iT邦新手 5 級 ‧ 2018-08-16 11:26:51 檢舉

介面大概是長這樣~ 0.0
你輸入的好像的確是這樣... Orz
是我弄太複雜了!?

不過原始的那行是語法邏輯錯誤嗎?
不能那樣表示麼(想知道錯在哪)? T口T

我改成你那樣的試試看

感恩~ ^^

art4444 iT邦新手 5 級 ‧ 2018-08-16 11:33:22 檢舉

唔... 我好像寫錯了...
本來應該是 "新增的資料" 比對 "舊的資料"
若舊的資料 "沒有" 新的資料
那就會在舊的資料裡新增一個
然後一筆一筆核對...
且新的資料是比較少的會不斷更新

似乎我那樣寫會亂套... 我再想想~

art4444 iT邦新手 5 級 ‧ 2018-08-16 12:00:24 檢舉

改成這樣應該可以... 測試中~ 口x口

Sub 新下載資料match()

 Dim LA As Long, LB As Long
 Dim k As Long, i As Long
 ActiveWorkbook.Worksheets("搜尋表").Select
 LA = Worksheets_
 ("搜尋表").Range("C500000").End(xlUp).Row
 
 ActiveWorkbook.Worksheets("新下載資料").Select
 LB = Worksheets_
 ("新下載資料").Range("C500000").End(xlUp).Row
 
 For i = 2 To LB

      Sheets("新下載資料").Select
      Cells(i, 2).Select
      
      If Cells(i,2).Value = "" Then Exit For
      
      For k = 2 To LA

           If Worksheets("新下載資料").cells(i,2).value = Worksheets("搜尋表").cells(k,2).value Then Exit For
                                        
           ElseIf Cells(k,2).Value = "" Then
 
                Rows(i).Select
                Rows(i).Copy
                Sheets("搜尋表").Select
                ActiveSheet.Paste Rows(k)
    
           End If

      Next     

 Next

End Sub