Board logo

標題: [發問] 2 張 sheet 對照，然後把漏了的 加入，vba 應怎樣寫？ [打印本頁]
作者: 119933775544    時間: 2010-10-19 12:00     標題: 2 張 sheet 對照，然後把漏了的 加入，vba 應怎樣寫？

[attach]3282[/attach]真的很苦惱，請各位賜教。 見附件，謝。
作者: oobird    時間: 2010-10-19 13:34

  1. Sub yy()
  2.     With Sheet1
  3.         rng = .Range(.Cells(3, 1), .Cells(3, 3).End(4))
  4.     End With
  5.     With Sheet2
  6.         For i = 1 To UBound(rng)
  7.             If .[A:A].Find(rng(i, 1), , , 1) Is Nothing Then
  8.                 .Cells(.[a65536].End(3).Row + 1, 1).Resize(, 3) = Array(rng(i, 1), rng(i, 2), rng(i, 3))
  9.             End If
  10.         Next
  11.     End With
  12. End Sub
複製代碼
作者: basarasy    時間: 2010-10-19 13:36

不可以直接copy到sheet2嗎?
作者: 119933775544    時間: 2010-10-19 17:12

回復 3# basarasy

謝謝各位師兄，我會試試看。
作者: GBKEE    時間: 2010-10-20 08:25

本帖最後由 GBKEE 於 2010-10-20 08:27 編輯

回復 3# basarasy
寫法不止一個
  1. Sub Ex()
  2.     Dim D As Object, E, Rng As Range
  3.     Set D = CreateObject("SCRIPTING.DICTIONARY")
  4.     For Each E In Sheet2.Range("A2", Sheet2.Range("A" & Rows.Count).End(xlUp))
  5.         D(E.Value) = E & ""
  6.     Next
  7.     For Each E In Sheet1.Range("A3", Sheet1.Range("A" & Rows.Count).End(xlUp))
  8.         If D.Exists(E.Value) = False Then
  9.             If Rng Is Nothing Then Set Rng = E.Resize(, 3) Else Set Rng = Union(Rng, E.Resize(, 3))
  10.         End If
  11.     Next
  12.     If Not Rng Is Nothing Then Rng.Copy Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1)
  13. End Sub
  14. Sub Ex1()
  15.     Dim E, a&, Rng As Range
  16.     For Each E In Sheet1.Range("A3", Sheet1.Range("A" & Rows.Count).End(xlUp))
  17.         If IsError(Application.Match(E, Sheet2.[a:a], 0)) Then
  18.             If Rng Is Nothing Then Set Rng = E.Resize(, 3) Else Set Rng = Union(Rng, E.Resize(, 3))
  19.         End If
  20.     Next
  21.     If Not Rng Is Nothing Then Rng.Copy Sheet2.Range("A" & Rows.Count).End(xlUp).Offset(1)
  22. End Sub
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)