1

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

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

第一种方法: 手动完成。数据 -> 编辑链接 -> 更改来源(失败,继续提示我提供链接)

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

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

请帮忙!!谢谢!

4

1 回答 1

2

首先,您为什么不能手动查找并替换所有“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
于 2013-07-26T18:55:55.063 回答