Question

我有一个与VBA有关的问题。

问题

我有一个代码可以完成简单的任务，但我不知道这是什么原因，但是有时这段代码有时可以完美地工作，而并非如此。

代码说明

转到工作簿中的活动工作表（未隐藏）。

在“分配”列中搜索特定的文本，在这种情况下，文本为“当前活动的总和”。

在文本之前复制单元格。

转到“审阅者”工作表，然后在表格中找到工作表名称。

将复制的单元格粘贴为表中具有工作表名称的单元格旁边的链接值。

继续相同的过程，直到搜索到所有活动工作表

代码

Sub Sum of_Current_activity() 
Dim sht As Worksheet
Sheets("Reviewer Sheet").Select

For Each sht In ActiveWorkbook.Worksheets
If sht.Name <> "Reviewer Sheet" And Left(sht.Name, 1) = 0 Then

On Error Resume Next 
sht.Select

f2 = " Total"
£1 = ActiveSheet.Name & f2

Sheets(sht).Select
Columns("J:J").Select
Selection.Find(What:="Sum of Current Activity", _
After:=ActiveCell,_
LookIn:=xlValues,_
LookAt:=xlPart,_
SearchOrder:=xlByRows,_
SearchDirection:=x1Next,_
MatchCase:=False).Activate

ActiveCell.Offset(0, 1).Select
Selection.Copy

Sheets("Reviewer Sheet").Select 
Columns("C:C").Select
Selection.Find(What:=f1, _
After:=ActiveCell,_
LookIn:=xlValues,_
LookAt:=xlPart,_
SearchOrder:=xlByRows,_
SearchDirection:=xlNext,_
MatchCase:=False).Activate

ActiveCell.Offset(0, 14).Select 
ActiveSheet. Paste Link:=True

Else
End If 

Next sht

  End Sub

附言，我在25个表格中有10种不同的特定文本可供搜索。该代码有时可用于所有10个文本，有时会遗漏值。

Answer 1

未经测试，但类似的方法应该起作用：

Sub Sum of_Current_activity() 
Dim sht As Worksheet, c1 As Range, c2 As range


For Each sht In ActiveWorkbook.Worksheets
    If sht.Name Like "0*" Then

        Set c1 = sht.Columns("J:J").Find(What:="Sum of Current Activity", _
                     LookIn:=xlValues,  LookAt:=xlPart, MatchCase:=False)

        Set c2 = Sheets("Reviewer Sheet").Columns("C:C").Find( _
                 What:= sht.Name & " Total", _
                 LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False) 

        If not c1 is nothing and not c2 is nothing then
            'edit: create link instead of copy value
            c2.offset(0, 14).Formula = _
              "='" & c1.parent.Name & "'!" & c1.offset(0,1).Address(true, true)

        End if


    End If    
Next sht

End Sub

Answer 2

仅仅因为任务很简单，您可以使用On Error Resume Next语句并在范围之间直接粘贴Value：

Sub main()
    Dim sht As Worksheet

    On Error Resume Next ' prevent any subsequent 'Find()' method failure fro stopping the code
    For Each sht In Worksheets
        If Left(sht.Name, 1) = "0" Then _
            Sheets("Reviewer Sheet").Columns("C:C").Find( _
                     What:=sht.Name & " Total", _
                     LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False).Offset(0, 14).Value = sht.Columns("J:J").Find(What:="Sum of Current Activity", _
                         LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False).Offset(0, 1).Value
    Next
End Sub

我再次强调，On Error Resume Next仅在这里使用是因为在这种情况下，您可以完全控制其因忽略错误而继续产生的副作用

您应该在更大的代码中使用此代码段，而不是使用On Error GoTo 0语句关闭代码段，并在继续其他代码之前恢复默认错误处理。

值无法正确捕获

2 个答案: