查找一個工作表中的值在指定範圍內的另一個

Question

意向

1. 這將包括11個相同的工作表（10對站點的數據輸入特定區域正在開發中，並且1「掌門人」它收集總數）
2. 主工作表是開始日期改變的地方。當更改開始日期時，它會反映在10個數據輸入工作表中。還有數字值表示開始日期有多遠。
3. 更改開始日期時，這些值需要隨開始日期一起移動（即，如果開始日期是1月5日並且數據輸入工作表上已有數據，並且開始日期更改爲1月7日，則全部所有工作表的數據將需要2移動到右）

擬過程

我能得到的前兩個函數的工作，但是這是這是造成一些悲傷的最後一個。

我想到的是一個程序化的複製粘貼。當更改開始日期時，它將轉到第一個數據錄入工作表，並將當前標題設置複製到「傳輸」工作表，保留該工作表的原始日期設置。然後它會刪除數據錄入工作清單中的數據。

下一步是轉到第一個數據輸入工作表（後臺代碼名以「Sz」開頭），將數據輸入的第一個數值匹配到Transfer工作表，檢索數據並粘貼列數據放入新的位置。

當它完成數據錄入工作表時，它會清除「傳輸」工作表，移動到下一個數據錄入工作表，然後重複該過程。

問題

不幸的是，我寫的是說這是發現的數值，當數值不存在的代碼。然後它有時會顯示一條錯誤消息，指出「代碼執行已被中斷」。

我一直在加班工作了大約十五個小時，除此之外還有整整一週的時間。我搜索了無數的潛在解決方案，並嘗試了很多解決方法，但正式處於死衚衕。我主要通過其他人的例子教會了我自己，所以我不是Excel VBA的專家。

如果我能得到匹配的功能正常工作，我相信我應該能夠處理其餘的，但更有效的方法的建議是非常值得歡迎的。

我不用太多論壇，但我會嘗試粘貼下面的代碼。

請讓我知道我可以提供什麼其他信息。

編輯：以下是工作簿的示例。要運行該功能，您將需要對 「工廠」 工作表（SZ001）：Dropbox Link

代碼：

Sub Test() 
Dim sh As Worksheet, flg As Boolean 

For Each sh In Worksheets 

'FUNCTIONAL: If sh.CodeName Like "Sz0*" Then 'flg = True 

If sh.CodeName = "Sz001" Then 'Isolating a single Worksheet for testing 

'Copy original values and location to Transfer Worksheet 
'DISABLED THIS SECTION WHILE TESTING 
'sh.Select 
'ActiveSheet.Range("H8:ABI460").Copy 
'Worksheets("Transfer").Select 
'ActiveSheet.Range("H8").PasteSpecial xlPasteValues 

'Begin Matching Loop -THIS IS WHERE THE ISSUES ARE HAPPENING 
Dim xlRange As Range 'Current sh Range 
Dim xlSheet As Worksheet 'Current sh Worksheet 
Dim xlCell As Range 'Cell function is currently looking at 
Dim x As Range 

Set xlSheet = sh 
Set xlRange = xlSheet.Range("H6:ABI6") 

For Each xlCell In xlRange 

    Set x = ActiveSheet.Cells.Find(what:=xlCell, after:=Worksheets("Transfer").Range("G6"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext) 

    If Not x Is Nothing Then 
     MsgBox Cells(xlCell.Row, xlCell.Column) & "Found" 
    Else 
     MsgBox Cells(xlCell.Row, xlCell.Column) & "Not Found" 
    End If 

Next xlCell 

End If 

Next 

End Sub 

Answer 1

測試：

Option Explicit 

Public Sub Test() 

    Const WS_TR  As String = "Transfer" 'Sheet Transfer 
    Const WS_RNG As String = "H6:ABI6" 'row 6 on both sheets 

    Dim wsSz As Worksheet, wsTr As Worksheet, cel As Range 
    Dim found As Range, row6Sz As Range, row6Tr As Range 

    Set wsSz = Sz001    'Code Name for the sheet "Sz001" 
    Set wsTr = Worksheets(WS_TR) 

    Set row6Sz = wsSz.Range(WS_RNG) 'searched values 
    Set row6Tr = wsTr.Range(WS_RNG) 'search area 

    For Each cel In row6Sz 'searched values 

     Set found = row6Tr.Find(what:=Val(cel.Value2), LookIn:=xlValues, _ 
           LookAt:=xlWhole, SearchFormat:=False, _ 
           SearchOrder:=xlByColumns, SearchDirection:=xlNext) 

     Debug.Print cel.Value2 & IIf(Not found Is Nothing, " Found", " Not Found") 

    Next 

End Sub 

。

注：

• 我更換了MSGBOX與Debug.Print
• 對於結果按按Ctrl +摹，或查看 - >立即窗口