Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Макрос по убийству ссылок на сторонние excel файлы, Помогите оптимизировать код
 
Коллеги, добрый день.

Пишу вам с целью проконсультироваться в вопросе оптимизации кода макроса. В связи с необходимостью на работе в екселе очень часто нужно убивать ссылки на сторонние excel файлы для того, чтобы в последствии избегать ошибок, когда рабочий файл начнет ссылаться на отсутствующие файлы. Для этого я написал следующий макрос. Скорость работы данного макроса меня устраивает, когда дело касается обработки небольших файлов, но когда мне нужно убить ссылки в файлах +1000 строк Excel зависает и все ломается. Как его оптимизировать, если это можно сделать я сам не знаю, поэтому и обратится за помощью к вам.
Код макроса:
Код
Sub RefDelList()

Dim im As Range, m As Range

Set myrange = ActiveSheet.UsedRange

For Each cell In myrange
    Dim icell As Range
    Set icell = myrange.Find(What:="*xls*", _
    LookIn:=xlFormulas, LookAt:=xlWhole, MatchCase:=True)
On Error Resume Next
    'icell.Style = "Normal"
    icell.Value = icell.Value
Next

End Sub

Заранее спасибо,

P.S. Прошу прощения за слишком частое использование слова файл

 
1. Зачем все это городить, если есть штатное средство Edit Links , которое позволяет в том числе убить и связь с конкретным файлом, но возможно этому есть причина.
2. Вам надо цикл делать не по всем ячейкам используемой области, а повторять поиск и замену до тех пор пока Find не вернет Nothing Range.Find  
 
Здравия. Не претендую на оптимальность. Как вижу.
Скрытый текст
Я в курсе об ограничении метода Union.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
ваще не оригинально , прям по гайду
Код
Sub RefDelList()
on error goto err1   
    With Application
        CalcOld = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    Set myrange = ActiveSheet.UsedRange
    Dim icell As Range
    
    Set icell = myrange.Find(What:=".xls", _
    LookIn:=xlFormulas, LookAt:=xlPart, MatchCase:=False)
    If Not icell Is Nothing Then
        firstAddress = icell.Address
        Do
            icell.Value = icell.Value
            Set c = myrange.FindNext(icell)
        Loop While Not icell Is Nothing And icell.Address <> firstAddress
    End If
err1:
    With Application
        .Calculation = CalcOld
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub
Изменено: БМВ - 26 Фев 2017 09:54:16
 
Del
Изменено: Sanja - 26 Фев 2017 09:33:16
Согласие есть продукт при полном непротивлении сторон.
 
Цитата
obratka написал: нужно убивать ссылки на сторонние excel файлы

Цитата
БМВ написал: которое позволяет в том числе убить и связь с конкретным файлом
Что убить-то нужно? Ссылки в формулах? Заменить формулы на значения?
Согласие есть продукт при полном непротивлении сторон.
 
Цитата
Sanja написал:
Ссылки в формулах? Заменить формулы на значения?
Так при удалении автоматом замена идет на значения. я про это.

А судя по коду так и надо, другое дело, что это действо по всей книге разорвет связи, а могу допустить что хочется только в определенной области.
 
Убьём все. На всякий случай
Скрытый текст
Изменено: Sanja - 26 Фев 2017 11:26:42
Согласие есть продукт при полном непротивлении сторон.
 
Код
Sub мяу()
    Dim arr1, arr2
    Dim i&, j&
    With ActiveSheet.UsedRange
        arr1 = .Formula
        arr2 = .Value
        For i = 1 To UBound(arr1)
            For j = 1 To UBound(arr1, 2)
                If InStr(arr1(i, j), "xls") Then arr1(i, j) = arr2(i, j)
            Next
        Next
        .Cells(1).Resize(.Rows.Count, .Columns.Count) = arr1
    End With
End Sub
 
Коллеги, спасибо за ответы!

Попробую ваши советы!
Страницы: 1
Читают тему (гостей: 1)