VBA Найти и заменить выпуск

Question

У меня есть книга, которая исходит от кого-то другого, поэтому путь к файлу относится к локальному диску этого человека. Поэтому мне нужно заменить путь к файлу на моем локальном диске. Я попробовал 3 метода, и все они потерпели неудачу. Пожалуйста, дайте мне несколько рекомендаций. В принципе, я пытаюсь найти замену 2 пути к файлам в пределах формулы для целого листа (почти все клетки) (смотри ниже):

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

1-й способ: ли это вручную. ДАТа -> Редактировать ссылки -> Изменить источники (Failed, продолжают побудила меня за ссылки)

второй метод: VBA: Сделал range.replace. Он только заменил первую ячейку и остановился.

3-й метод: 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