《發問》vba-名單比對相符合回寫資料

eric093

請教各位高手，關於比對名單的vba寫法，只要符合《資料來源》的A欄位符合《名單》摺頁的人名，即將特定的欄位回寫在另一個工作頁（比對後資料），
由於資料來源每日會有數千筆，所以，我寫了簡單的程式碼後，通常都要RUN很久~不知道有什麼方法可以再快些！

Sub 比對名單()

Sheets("比對後資料").Select
Cells.Clear


Sheets("資料來源").Select
k = Sheets("資料來源").Range("a65536").End(xlUp).Row
p = Sheets("名單").Range("a65536").End(xlUp).Row

Sheets("比對後資料").Cells(1, 1).Value = Sheets("資料來源").Cells(1, 1)
Sheets("比對後資料").Cells(1, 4).Value = Sheets("資料來源").Cells(1, 3)
Sheets("比對後資料").Cells(1, 5).Value = Sheets("資料來源").Cells(1, 4)
  c = 2
For n = 2 To k
       For m = 1 To p

  If Sheets("資料來源").Cells(n, 1) = Sheets("名單").Cells(m, 1) Then                     
        Sheets("比對後資料").Cells(c, 1).Value = Sheets("資料來源").Cells(n, 1)
         Sheets("比對後資料").Cells(c, 3).Value = Sheets("資料來源").Cells(n, 3)
        Sheets("比對後資料").Cells(c, 4).Value = Sheets("資料來源").Cells(n, 4)
         
               c = c + 1
              
               
   
   End If
    Next
  Next
  
  

End Sub

yen956

回復 21# GBKEE
沒錯, 改進中.
謝謝G大再三指導, 謝謝!!

GBKEE

回復 20# yen956
   

一向很少用Option Explicit,

如程式龐大些,這習慣不好.

yen956

謝謝GBKEE大, 詳細的解說,
一向很少用Option Explicit,
竟然連最基本的資料型態都忘了,
要好好爬文了, 謝謝.

GBKEE

回復 18# yen956

Dim A As Long

   

VBA 的說明

Long 資料型態 Long (長整數)變數係以範圍從 -2,147,483,648 到 2,147,483,647 之 32 位元 (4 個位元組) 有號數字形式儲存。Long 的型態宣告字元為 &。

yen956

回復 4# Hsieh
請問大大：
Dim A As Range, Rng As Range, Ar(), s&
中的 s& 作用是什麼?
(我用 "Dim s&" 站內搜尋過了, 搜不到)

GBKEE

回復 16# handsometrowa

1. Option Explicit
   
2. Sub tt()
   
3.     Dim Rng(1 To 3) As Range, E As Range
   
4.     Set Rng(1) = Sheets("名單").Range("a2")
   
5.     Set Rng(2) = Sheets("資料來源").Range("a:a")
   
6.     Sheets("比對後資料").UsedRange.Offset(1).Clear ''清除舊有資料
   
7.     Do While Rng(1) <> ""
   
8.         Set Rng(3) = Rng(2).Find(Rng(1), lookat:=xlWhole)
   
9.         If Not Rng(3) Is Nothing Then    '確定範圍有Rng(1)的字串
   
10.             '通常要搜尋特定的資料資串會用FIND 一一的搜尋
    
11.             '這裡用Replace 方法 一次將搜尋特定的資料資串,改為錯誤值
    
12.             '也是一中搜尋特定的資料資串的方法
    
13.             Rng(2).Replace Rng(1), "=book", xlWhole
    
14.             With Rng(2).SpecialCells(xlCellTypeFormulas, xlErrors) '特殊的範圍(公式,錯誤值)
    
15.                                                                    'Rng(2)範圍有"錯誤值"的儲存格
    
16.                 .Value = Rng(1)  '更正回原有的資料
    
17.                 For Each E In .Cells
    
18.                     With Sheets("比對後資料")
    
19.                         With .Cells(.UsedRange.Rows.Count + 1, "A")
    
20.                             .Range("A1") = E
    
21.                             .Range("B1") = E.Range("B1")
    
22.                             .Range("C1") = Rng(1).Range("B1")
    
23.                         End With
    
24.                    End With
    
25.                 Next
    
26.             End With
    
27.         End If
    
28.         Set Rng(1) = Rng(1).Offset(1)
    
29.     Loop
    
30. End Sub

複製代碼

handsometrowa

回復 6# GBKEE


    請問G大
關於下面三句，我有點不解，為什麼找出相同人名之後，需要將範圍變成錯誤  ，卻又要在後面把人名又改正確呢....@@?

Rng(1).Replace Rng(2), "=gbkee", xlWhole                '將相同的人名替換為錯誤值
            With Rng(1).SpecialCells(xlCellTypeFormulas, xlErrors)  '特殊的範圍(公式,錯誤值)
                .Value = Rng(2)  

eric093

謝謝版大
我懂我卡在哪了！

GBKEE

回復 13# eric093
試試看

1. Option Explicit
   
2. Sub tt()
   
3.     Dim Rng(1 To 3) As Range, E As Range
   
4.     Set Rng(1) = Sheets("名單").Range("a2")
   
5.     Set Rng(2) = Sheets("資料來源").Range("a:a")
   
6.     Sheets("比對後資料").UsedRange.Offset(1).Clear ''清除舊有資料
   
7.     Do While Rng(1) <> ""
   
8.         Set Rng(3) = Rng(2).Find(Rng(1), lookat:=xlWhole)
   
9.         If Not Rng(3) Is Nothing Then
   
10.             Rng(2).Replace Rng(1), "=book", xlWhole
    
11.             With Rng(2).SpecialCells(xlCellTypeFormulas, xlErrors)
    
12.                 .Value = Rng(1)
    
13.                 For Each E In .Cells
    
14.                     With Sheets("比對後資料")
    
15.                         With .Cells(.UsedRange.Rows.Count + 1, "A")
    
16.                             .Range("A1") = E
    
17.                             .Range("B1") = E.Range("B1")
    
18.                             .Range("C1") = Rng(1).Range("B1")
    
19.                         End With
    
20.                    End With
    
21.                 Next
    
22.             End With
    
23.         End If
    
24.         Set Rng(1) = Rng(1).Offset(1)
    
25.     Loop
    
26. End Sub

複製代碼