eric093

我以GBKEE版主提供的進行了解後，要再調整將SHEETS("名單")的B欄位也同時回寫在SHEETS("比對後資料")，經改了一下後，結果帶出的資料不正確，請大家指導我！


Sub tt()
Dim rng(1 To 5) As Range, E, K As Range

Set rng(1) = Sheets("名單").Range("a2")

Set rng(3) = Sheets("資料來源").Range("a:a")

Do While rng(1) <> ""
Set rng(4) = rng(3).Find(rng(1), lookat:=xlWhole)

If Not rng(4) Is Nothing Then
       rng(3).Replace rng(1), "=book", xlWhole
       With rng(3).SpecialCells(xlCellTypeFormulas, xlErrors)
            .Value = rng(1)
            With rng(1)
             For Each E In .Cells
                For Each K In .Cells
               
                   With Sheets("比對後資料")
                         Cells(.UsedRange.Rows.Count + 1, "C").Value = K.Offset(, 1)
                        Cells(.UsedRange.Rows.Count, "A").Value = E
                        Cells(.UsedRange.Rows.Count, "B").Value = E.Range("B1")
                     
               
                   End With
                Next
             Next
             End With
       End With
      
      
End If
Set rng(1) = rng(1).Offset(1)


Loop




End Sub

GBKEE

回復 11# eric093

1. '沒看到檔案不解為何要
   
2. For Each E In .Cells      
   
3.                 For Each K In .Cells
   
4. '有兩個  For Each  , 一個  For Each 不行嗎?
   
5.                    With Sheets("比對後資料")
   
6.                     前面要      .Cells(.UsedRange.Rows.Count + 1, "C").Value = K.Offset(, 1)
   
7.                     前面要     .Cells(.UsedRange.Rows.Count, "A").Value = E
   
8.                     前面要     .Cells(.UsedRange.Rows.Count, "B").Value = E.Range("B1")                     
   
9.                
   
10.                    End With
    
11.                 Next
    
12.              Next

複製代碼

eric093

回復 12# GBKEE


    先謝謝版主看到我的求救！
我說明一下~
原程式內容已可以回寫資料來源（我也弄懂了），但我嘗試要將名單摺頁的B欄（性別）也一併帶入比對後資料！
我試了好久，也上網查了好久，我實在能力不足，無法參透如何改！

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

複製代碼

eric093

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

handsometrowa

回復 6# GBKEE


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

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

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

複製代碼

yen956

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

GBKEE

回復 18# yen956

Dim A As Long

   

VBA 的說明

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

yen956

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