Question

意图

它将由11个相同的工作表组成（10个用于正在处理的站点的数据输入特定区域，1个“Master”用于收集总数）
主工作表是更改开始日期的位置。更改开始日期后，它将反映在10个数据条目工作表中。还有数值显示开始日期的距离。
当更改开始日期时，值需要与开始日期一起移动（即，如果开始日期是1月5日，并且数据输入工作表上已有数据，如果开始日期更改为1月7日，那么所有所有工作表上的数据都需要通过2）

预期流程

我能够让前两个功能正常工作，但这是导致一些悲伤的最后一个功能。

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

下一步是转到第一个数据输入工作表（后台的Codenames以“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

注意：

我用 Debug.Print
对于结果，按 Ctrl + G 或View - ＆gt;立即窗口

在另一个

1 个答案: