返回列表 上一主題 發帖

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

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
1# 跳轉到 »
發表於 2016-6-26 20:58 | 顯示全部帖子
回復 2# Michelle-W
其實你原本之程式碼稍加調整，
也是可行的：
  1. Sub 比對新增()
  2.     Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr1 As Long, lr2 As Long
  3.     Dim rng1 As Range, rng2 As Range, c As Variant, cts As Variant, ct2 As Variant
  4.    
  5.     Set sh1 = Sheets(1)        '  資料
  6.     Set sh2 = Sheets(2)        '  List
  7.     Set sh3 = Sheets(3)        '  此次新增
  8.    
  9.     lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row    '  資料
  10.     lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row    '  List
  11.    
  12.     Set rng1 = sh1.Range("A1:A" & lr1)        '  資料
  13.     Set rng2 = sh2.Range("A1:A" & lr2)        '  List
  14.    
  15.     With sh3                                  '  此次新增
  16.         .Cells.Clear

  18.         '  .Range("A1") = "姓名"
  19.         '  .Range("B1") = "年齡"
  20.         '  .Range("C1") = "婚姻"
  21.         .Range("A1").Resize(, 3) = Split("姓名,年齡,婚姻", ",")
  22.     End With
  23.    
  24.     For Each c In rng1                                          '  資料
  25.         Set cts = rng1.Find(c.Value, , LookIn:=xlValues)
  26.         Set ct2 = rng2.Find(c.Value, , LookIn:=xlValues)
  27.         '  If WorksheetFunction.CountIf(rng2, c.Value) = 0 Then
  28.         If Not cts Is Nothing And ct2 Is Nothing Then                                          '  List
  29.             sh3.Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 3) = sh1.Rows(cts.Row).Value    '  此次新增
  30.         End If
  31.     Next
  32. End Sub
複製代碼
GBKEE 版大那兒，你也可以學到不錯的觀念與技巧。

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
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)
如果你依然想用原本之宣告
  1. If WorksheetFunction.CountIf(rng2, c.Value) = 0 Then
  2.        .
  3.        .
  4. End If
複製代碼
亦可， 其與樓上 (#6) 的
  1. If Not cts Is Nothing And ct2 Is Nothing Then
  2.        .
  3.        .
  4. End If
複製代碼
表述是異曲同工。(省略了 ct2 的變數宣告與給予值 (Assign Value) 的設定 )
  1. Sub 比對新增2()
  2.     Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr1 As Long, lr2 As Long
  3.     Dim rng1 As Range, rng2 As Range, c As Variant, cts As Variant
  4.    
  5.     Set sh1 = Sheets(1)        '  資料
  6.     Set sh2 = Sheets(2)        '  List
  7.     Set sh3 = Sheets(3)        '  此次新增
  8.    
  9.     lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row    '  資料
  10.     lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row    '  List
  11.    
  12.     Set rng1 = sh1.Range("A1:A" & lr1)        '  資料
  13.     Set rng2 = sh2.Range("A1:A" & lr2)        '  List
  14.    
  15.     With sh3                                  '  此次新增
  16.         .Cells.Clear

  18.         '  .Range("A1") = "姓名"
  19.         '  .Range("B1") = "年齡"
  20.         '  .Range("C1") = "婚姻"
  21.         .Range("A1").Resize(, 3) = Split("姓名,年齡,婚姻", ",")
  22.     End With
  23.    
  24.     For Each c In rng1                                          '  資料
  25.         Set cts = rng1.Find(c.Value, , LookIn:=xlValues)
  26.         
  27.         If WorksheetFunction.CountIf(rng2, c.Value) = 0 Then
  28.             sh3.Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 3) = sh1.Rows(cts.Row).Value    '  此次新增
  29.         End If
  30.     Next
  31. End Sub
複製代碼
抑或是根本不使用  cts、ct2 的兩個變數宣告與給予值 (Assign Value) 的設定
  1. Sub 比對新增3()
  2.     Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr1 As Long, lr2 As Long
  3.     Dim rng1 As Range, rng2 As Range, c As Variant
  4.    
  5.     Set sh1 = Sheets(1)        '  資料
  6.     Set sh2 = Sheets(2)        '  List
  7.     Set sh3 = Sheets(3)        '  此次新增
  8.    
  9.     lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row    '  資料
  10.     lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row    '  List
  11.    
  12.     Set rng1 = sh1.Range("A1:A" & lr1)        '  資料
  13.     Set rng2 = sh2.Range("A1:A" & lr2)        '  List
  14.    
  15.     With sh3                                  '  此次新增
  16.         .Cells.Clear

  18.         '  .Range("A1") = "姓名"
  19.         '  .Range("B1") = "年齡"
  20.         '  .Range("C1") = "婚姻"
  21.         .Range("A1").Resize(, 3) = Split("姓名,年齡,婚姻", ",")
  22.     End With
  23.    
  24.     For Each c In rng1                                          '  資料
  25.         If WorksheetFunction.CountIf(rng2, c.Value) = 0 Then
  26.             sh3.Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 3) = sh1.Rows(c.Row).Value    '  此次新增
  27.         End If
  28.     Next
  29. End Sub
複製代碼
其結果仍是一致的。
此端視你個人撰寫的經驗、習慣與邏輯思考。
比對新增資料(回歸原始).rar (16.91 KB)

TOP

        靜思自在 : 發脾氣是短暫的發瘋。
返回列表 上一主題