iT邦幫忙

0

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

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

為了將新的資料與舊的資料進行比對
將新的資料 在舊的資料(工作表)做新增的工作(更新)
故設計了一個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邦研究生 1 級 ‧ 2018-08-15 12:18:19 檢舉
你有試跑過嗎?
art4444 iT邦新手 5 級 ‧ 2018-09-07 10:49:38 檢舉
我試試看
art4444 iT邦新手 5 級 ‧ 2018-09-07 10:49:39 檢舉
我試試看

1 個回答

0
paicheng0111
iT邦研究生 1 級 ‧ 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
看更多先前的回應...收起先前的回應...
art4444 iT邦新手 5 級 ‧ 2018-08-15 16:07:18 檢舉

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

paicheng0111 iT邦研究生 1 級 ‧ 2018-08-15 17:26:36 檢舉

能貼個圖來看看嗎?

paicheng0111 iT邦研究生 1 級 ‧ 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 檢舉

https://ithelp.ithome.com.tw/upload/images/20180816/20110191O0qnJQXZYg.jpghttps://ithelp.ithome.com.tw/upload/images/20180816/2011019125oSWvx1v8.jpg

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

paicheng0111 iT邦研究生 1 級 ‧ 2018-08-16 13:46:10 檢舉

測試結果呢?符合您的預期嗎?

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

剛剛測試了一次...
不知為何,結果很微妙...
搜尋表有281筆資料,新下載資料表有3筆資料(沒有重複)
執行巨集後...
有複製到第三筆,但位置很奇怪...
我等等貼個圖~

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

https://ithelp.ithome.com.tw/upload/images/20180816/20110191sanEsWKDWR.jpghttps://ithelp.ithome.com.tw/upload/images/20180816/20110191M18VQRTiwG.jpghttps://ithelp.ithome.com.tw/upload/images/20180816/20110191sKry4iVEf4.jpg

art4444 iT邦新手 5 級 ‧ 2018-08-16 16:16:01 檢舉

第一張圖:
"新下載資料" 的3筆資料, 分別在第2.3.4列.
第二章圖:
"搜尋表" 的281筆資料, 分別在第2.3.4...282列.
第三張圖:
執行後, "搜尋表" 的第5列資料被 "新下載資料" 的第4筆資料取代,
其他不變.

art4444 iT邦新手 5 級 ‧ 2018-09-03 16:37:12 檢舉

仍然卡在複製階段...

paicheng0111 iT邦研究生 1 級 ‧ 2018-09-03 23:24:11 檢舉

試試看我的新版本

art4444 iT邦新手 5 級 ‧ 2018-09-07 11:07:58 檢舉

iferror這裡會出錯~
顯示: 沒有定義這個Sub或Function

paicheng0111 iT邦研究生 1 級 ‧ 2018-09-07 12:27:33 檢舉

已經修改iferror這一行了

art4444 iT邦新手 5 級 ‧ 2018-09-07 14:29:32 檢舉

一樣耶~ 0w0
是不是有額外設定好函數?

paicheng0111 iT邦研究生 1 級 ‧ 2018-09-07 16:46:56 檢舉

my typo iserror

art4444 iT邦新手 5 級 ‧ 2018-09-10 13:50:14 檢舉

我把iferror改成iserror
可以執行了~
也會進行複製的動作...
但是僅只會複製B欄~
我的目標是整列~ XD

我要發表回答

立即登入回答