VBA 查找和替换问题

Question

我有一个来自其他人的工作簿，因此文件路径是指该人的本地驱动器。所以我需要用我本地驱动器中的文件路径替换文件路径。我尝试了 3 种方法，但都失败了。请给我一些指导方针。基本上，我试图在整个工作表（几乎所有单元格）的公式中找到替换 2 个文件路径（见下文）：

='U:\Futochan\2012\[Futochan2012.xlsm]Counts'!E6+'U:\Futochan\2013\[Futochan2013.xlsm]Counts'!E6

第一种方法： 这是手动完成的。数据 -> 编辑链接 -> 更改来源（失败，继续提示我提供链接）

第二种方法： VBA：range.replace 了。它只替换了第一个单元格并停止了。

第三种方法： VBA：逐个单元格循环：“对于范围内的每个单元格”。我关掉了一切。它工作但花了2个小时。 ：/

请帮忙！！谢谢！

Answer 1

首先，您为什么不能手动查找并替换所有“U:\Futochan\2012[Futochan2012.xlsm]”？如果只是两个链接，而且这是一次性的，这是迄今为止最快的方法。

对于 Range.replace，您的范围是多少？如果您在 Worksheet.Cells.replace(...) 上调用它，它应该替换所有实例。

最后，下面是一种不涉及 Range.Replace 的快速方法，但同样，重新发明轮子并不是一种可取的方法：)

Private stringsToReplace As New Collection
Sub blah()
    Dim ws As Worksheet
    Dim arr
    Dim formulaCells As Range, area As Range
    Dim i As Long, j As Long

    stringsToReplace.Add Array("old1", "new1") 'add as many pairs as you like in the format of Array(oldString,newString)

    Set ws = ActiveSheet

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    On Error Resume Next
    Set formulaCells = ws.Cells.SpecialCells(xlCellTypeFormulas) 'only look at formula cells for speed
    On Error GoTo 0

    If Not formulaCells Is Nothing Then

        For Each area In formulaCells 'we will load into an array in memory, to prevent the horrendously slow enumeration through cells
            If area.Count = 1 Then
                area.Formula = newFormulaText(area.Formula)
            Else
                arr = area.Formula
                For i = LBound(arr, 1) To UBound(arr, 1)
                    For j = LBound(arr, 2) To UBound(arr, 2)
                        arr(i, j) = newFormulaText(arr(i, j))
                    Next j
                Next i
                area.Formula = arr
            End If
        Next area

    End If

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub
Function newFormulaText(ByVal oldText As String) As String
    Dim oldNewPair
    Dim newText As String
    newText = oldText
    For Each oldNewPair In stringsToReplace
        newText = Replace(newText, oldNewPair(0), oldNewPair(1))
    Next oldNewPair
    newFormulaText = newText
End Function