Страницы: 1
RSS
Макрос на изменение связей в 1 столбце
 
Добрый день! Есть макрос изменяющий связи во всей папке с файлами, нужно сделать так, чтоб менял связи только в столбце F.
Подскажите пожалуйста как это сделать

Sub MassReplace()
   Dim aFiles As Variant
   aFiles = ShowFileDialog()
   If IsEmpty(aFiles) Then Exit Sub
   
   Dim form1 As String
   Dim form2 As String
   
   form1 = InputBox("Что заменить?", "Что заменить?", "'O:\SPP\ВЭС\ГИСТЭК\Макет 4.44\январь\готовые сводные акты\")
   form2 = InputBox("На что заменить?", "На что заменить?", "'O:\SPP\ВЭС\ГИСТЭК\Макет 4.44\февраль\готовые сводные акты\")
   
   If form1 = "" Then Exit Sub
   If form2 = "" Then Exit Sub
   
   Application.EnableEvents = False
   Dim Application_Calculation As Long
   Application_Calculation = Application.Calculation
   Application.Calculation = xlCalculationManual
   
   Dim vFile As Variant
   For Each vFile In aFiles
       JobFile vFile, form1, form2
   Next
   
   Application.Calculation = Application_Calculation
   Application.EnableEvents = True
End Sub

Private Sub JobFile(ByVal sFull As String, form1 As String, form2 As String)
   Dim wb As Workbook
   Set wb = Workbooks.Open(sFull)
   
   Dim sh As Worksheet
   For Each sh In wb.Worksheets
       JobSheet sh, form1, form2
   Next
   
   wb.Close True
End Sub

Private Sub JobSheet(sh As Worksheet, form1 As String, form2 As String)
   Dim rr As Range
   On Error Resume Next
   Set rr = sh.UsedRange.SpecialCells(xlCellTypeFormulas)
   On Error GoTo 0
   If Not rr Is Nothing Then
       Dim cl As Range
       For Each cl In rr
           JobCell cl, form1, form2
       Next
   End If
End Sub

Private Sub JobCell(cl As Range, form1 As String, form2 As String)
   With cl
       .FormulaR1C1 = Replace(.FormulaR1C1, form1, form2)
   End With
End Sub

Private Function ShowFileDialog() As Variant
   Dim oFD As FileDialog
   Dim x, lf As Long
   'назначаем переменной ссылку на экземпляр диалога
   Set oFD = Application.FileDialog(msoFileDialogFilePicker)
   With oFD 'используем короткое обращение к объекту
   'так же можно без oFD
   'With Application.FileDialog(msoFileDialogFilePicker)
       .AllowMultiSelect = True
       .Title = "Выбрать файлы" 'заголовок окна диалога
       .Filters.Clear 'очищаем установленные ранее типы файлов
       .Filters.Add "Excel files", "*.xls*;*.xla*", 1 'устанавливаем возможность выбора только файлов Excel
       '.Filters.Add "Text files", "*.txt", 2 'добавляем возможность выбора текстовых файлов
       .FilterIndex = 1 'устанавливаем тип файлов по умолчанию - Text files(Текстовые файлы)
       .InitialFileName = ThisWorkbook.Path '"С:\Temp\Книга1.xlsx" 'назначаем папку отображения и имя файла по умолчанию
       .InitialView = msoFileDialogViewDetails 'вид диалогового окна(доступно 9 вариантов)
       If .Show = 0 Then Exit Function 'показывает диалог
       Dim arr As Variant
       ReDim arr(1 To .SelectedItems.Count)
       'цикл по коллекции выбранных в диалоге файлов
       For lf = 1 To .SelectedItems.Count
           arr(lf) = .SelectedItems(lf) 'считываем полный путь к файлу
       Next
       ShowFileDialog = arr
   End With
End Function
Изменено: Diatr - 23.11.2022 09:08:37
 
Diatr,
просто запишите макрос замены в столбце)

Код
Range("F:F").Replace What:="Ссылка1", Replacement:="Ссылка2", LookAt:=2
Изменено: evgeniygeo - 23.11.2022 09:29:58
 
evgeniygeo, а не подскажите куда именно это вставить в мой макрос? т.е мне же нужно чтоб макрос брал папку, открывал из нее все файлы, заменял связи в столбце F, закрывал все файлы.
 
не нужно это никуда вставлять)
замените
  Set rr = sh.UsedRange.SpecialCells(xlCellTypeFormulas)
на
  Set rr = sh.Range("F:F").SpecialCells(xlCellTypeFormulas)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, Спасибо!
Страницы: 1
Наверх