从另一个工作表中的指定范围中查找值

意图

1. 它将包含11个相同的工作表（10个用于正在处理的网站的数据录入特定区域，1个收集总数的“主”）
2. 主工作表是开始date改变的地方。 当开始date改变时，它反映在10个数据input工作表中。 还有数字值显示开始date有多远。
3. 当更改开始date时，这些值需要随开始date一起移动（即，如果开始date是1月5日，并且数据input工作表上已经有数据，如果开始date更改为1月7日，则所有数据全部工作表将需要移动到2）

预期的过程

我能够得到前两个function的工作，但是这是最后一个导致一些悲伤。

我想到的是一个程序化的复制粘贴。 当更改开始date时，将转到第一个数据input工作表，并将当前标题设置复制到“传输”工作表，保留该工作表的原始date设置。 然后它会删除数据录入工作清单中的数据。

下一步是转到第一个数据input工作表（后台的代码名以“Sz”开始），将数据input的第一个数值匹配到Transfer工作表，检索数据并粘贴列数据新的位置。

完成数据input工作表后，它将清除“传输”工作表，移至下一个数据input工作表，然后重复该过程。

问题

不幸的是，我写的代码是说当数字值不存在时，它正在查找数字值。 然后它有时会出现一个错误消息，说明“代码执行已被中断”。

除了大概一个星期，我一直在加class工作了大约十五个小时。 我已经search了无数潜在的解决scheme，并尝试了很多解决方法，但正式处于死胡同。 我主要是通过其他人的例子教我自己，所以我不是Excel VBA的专家。

如果我能够使匹配的function正常工作，我相信我应该能够处理其余的问题，但更有效的方法的build议是值得欢迎的。

我不用太多的论坛，但我会尝试粘贴下面的代码。

请让我知道我可以提供什么其他信息。

编辑 ：这是工作簿的示例。 要运行该function，您需要在“工厂”工作表（Sz001）上： Dropbox链接

码：

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

testing：

 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 

。

注意：

• 我用Debug.Printreplace了MsgBox
• 对于结果按Ctrl + G ，或查看 – >立即窗口