關於新增資料的比對 - Excel程式區

[發問] 關於新增資料的比對

1^# 跳轉到 »

發表於 2016-6-26 20:58 | 顯示全部帖子

回復 2# Michelle-W
其實你原本之程式碼稍加調整，
也是可行的：

Sub 比對新增()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr1 As Long, lr2 As Long
Dim rng1 As Range, rng2 As Range, c As Variant, cts As Variant, ct2 As Variant
Set sh1 = Sheets(1) ' 資料
Set sh2 = Sheets(2) ' List
Set sh3 = Sheets(3) ' 此次新增
lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row ' 資料
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row ' List
Set rng1 = sh1.Range("A1:A" & lr1) ' 資料
Set rng2 = sh2.Range("A1:A" & lr2) ' List
With sh3 ' 此次新增
.Cells.Clear
' .Range("A1") = "姓名"
' .Range("B1") = "年齡"
' .Range("C1") = "婚姻"
.Range("A1").Resize(, 3) = Split("姓名,年齡,婚姻", ",")
End With
For Each c In rng1 ' 資料
Set cts = rng1.Find(c.Value, , LookIn:=xlValues)
Set ct2 = rng2.Find(c.Value, , LookIn:=xlValues)
' If WorksheetFunction.CountIf(rng2, c.Value) = 0 Then
If Not cts Is Nothing And ct2 Is Nothing Then ' List
sh3.Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 3) = sh1.Rows(cts.Row).Value ' 此次新增
End If
Next
End Sub

複製代碼

GBKEE 版大那兒，你也可以學到不錯的觀念與技巧。

2^#

發表於 2016-6-26 21:22 | 顯示全部帖子

本帖最後由 c_c_lai 於 2016-6-27 06:13 編輯

回復 4# Michelle-W

比對新增資料.rar (23.51 KB)
附上檔案供你測試。

比對新增資料(xls 格式).rar (13.85 KB)
如果你依然想用原本之宣告

複製代碼

亦可，其與樓上 (#6) 的

複製代碼

表述是異曲同工。(省略了 ct2 的變數宣告與給予值 (Assign Value) 的設定 )

Sub 比對新增2()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr1 As Long, lr2 As Long
Dim rng1 As Range, rng2 As Range, c As Variant, cts As Variant
Set sh1 = Sheets(1) ' 資料
Set sh2 = Sheets(2) ' List
Set sh3 = Sheets(3) ' 此次新增
lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row ' 資料
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row ' List
Set rng1 = sh1.Range("A1:A" & lr1) ' 資料
Set rng2 = sh2.Range("A1:A" & lr2) ' List
With sh3 ' 此次新增
.Cells.Clear
' .Range("A1") = "姓名"
' .Range("B1") = "年齡"
' .Range("C1") = "婚姻"
.Range("A1").Resize(, 3) = Split("姓名,年齡,婚姻", ",")
End With
For Each c In rng1 ' 資料
Set cts = rng1.Find(c.Value, , LookIn:=xlValues)
If WorksheetFunction.CountIf(rng2, c.Value) = 0 Then
sh3.Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 3) = sh1.Rows(cts.Row).Value ' 此次新增
End If
Next
End Sub

複製代碼

抑或是根本不使用 cts、ct2 的兩個變數宣告與給予值 (Assign Value) 的設定

Sub 比對新增3()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr1 As Long, lr2 As Long
Dim rng1 As Range, rng2 As Range, c As Variant
Set sh1 = Sheets(1) ' 資料
Set sh2 = Sheets(2) ' List
Set sh3 = Sheets(3) ' 此次新增
lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row ' 資料
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row ' List
Set rng1 = sh1.Range("A1:A" & lr1) ' 資料
Set rng2 = sh2.Range("A1:A" & lr2) ' List
With sh3 ' 此次新增
.Cells.Clear
' .Range("A1") = "姓名"
' .Range("B1") = "年齡"
' .Range("C1") = "婚姻"
.Range("A1").Resize(, 3) = Split("姓名,年齡,婚姻", ",")
End With
For Each c In rng1 ' 資料
If WorksheetFunction.CountIf(rng2, c.Value) = 0 Then
sh3.Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 3) = sh1.Rows(c.Row).Value ' 此次新增
End If
Next
End Sub

複製代碼

其結果仍是一致的。
此端視你個人撰寫的經驗、習慣與邏輯思考。

比對新增資料(回歸原始).rar (16.91 KB)

靜思自在 : 能善用時間的人，必能掌握自己努力的方向。