Question

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

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

第一种方法： 这是手动完成的。 DAta - ＆gt;编辑链接 - ＆gt;更改来源（失败，继续提示我输入链接）

第二种方法： 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

VBA查找并替换问题

1 个答案: