Заменить в Excel-книге ссылку для другого


У меня в Excel-книге, где у нас есть лист, где мы консолидируем данные. В основном мы ссылаемся на другие программы Excel-книги. Я написал следующий макрос, для того, чтобы обновить путь и имя файла. Мы не можем просто обновить всю ссылку, так как других частей необходимо ссылаться на старый путь (и имя).

Sub neueDatei()

Dim Pfad As String, DateiName As String, DateiName_alt As String, h As String, formel As String
Dim tblRow As Long, test As Long
Dim wb As Workbook
Dim IVsh As Worksheet

Application.ScreenUpdating = False

Set wb = ActiveWorkbook

Set IVsh = wb.Sheets("Input Vektor")

With IVsh
    Pfad = .Range("C3").Value 'set the path
    DateiName = .Range("C4").Value 'set the filename
    tblRow = .Cells(.Rows.Count, 1).End(xlUp).Row 'find last row
End With

If Mid(Pfad, Len(Pfad) - 1, 1) <> "\" Then
    Pfad = Pfad & "\" 'append \ if necessary
End If

If Mid(Pfad, 1, 1) <> "'" Then
    Pfad = "'" & Pfad 'excel needs a quote at the start of the path.
End If

DateiName_alt = DateiName

'add brackets to the filename
If Mid(DateiName, 1, 1) <> "[" Then
    DateiName = "[" & DateiName 
    DateiName = DateiName & "]"
End If

'substitute the filenames
For i = 19 To tblRow
    If IVsh.Cells(i, 7).Value <> "" Then
        Exit For
    End If
    h = IVsh.Cells(i, 2).Formula
    If InStr(1, h, "[") > 0 Then
        IVsh.Cells(i, 2).Formula = "=" & Pfad & DateiName & Mid(h, InStr(1, h, "]") + 1)
    Else
        IVsh.Cells(i, 2).Formula = "=" & Pfad & DateiName_alt & Mid(h, InStr(1, h, "xlsx") + 4)
    End If
Next i

Application.ScreenUpdating = True

End Sub

Проблема в том, что код работает достаточно медленно (несколько минут всего за 2-3 тысячи строк). Любые предложения, как я могу ускорить этот процесс?



Комментарии
3 ответа

Я собираюсь сделать предположение, что слово новое имеет смысл на том языке, который является родным для этого, как это не английский. Но что я в конце подразделов, что это?


Это хорошая практика для отступа кода этак Labels будет торчать как очевидное.


Вы забыли определить i

Когда вы не определяете переменную, ВБА объявим его как вариант, которые являются объектами:


Производительности. Переменная, объявленная с типом объекта является гибким
достаточно, чтобы содержать ссылку на любой объект. Однако, когда вы вызываете
метод или свойство на такую переменную, вы всегда нести позднего связывания
(во время выполнения). В силу раннее связывание (во время компиляции) и лучше
производительность, объявить переменную с определенным именем класса, или литой
ее к определенному типу данных.

Всегда включаю Option Explicit. Вы можете иметь его автоматически, зайдя в Инструменты -> Параметры в программу и проверки требуют переменной вариант. Таким образом, если у вас есть какие-либо переменные не определен, компилятор даст вам знать.


Правил Именования Переменных


Dim Pfad As String, DateiName As String, DateiName_alt As String, h As String, formel As String
Dim tblRow As Long, test As Long
Dim wb As Workbook
Dim IVsh As Worksheet

Ваши имена оставляют желать лучшего, даже если я игнорировать то, что имена могут быть написаны после того, как в любой ваш родной язык.

Давать переменным осмысленные имена! Это делает жизнь легче на вас , когда вы вернуться к этому проекту позже.

Что делать pFad, h, test и IVsh скажи мне, о чем они? Я предполагаю, что pFad что-то короткое для эквивалента путь к файлу, так как fpath. Почему не пишется целиком? Персонажи бесплатно - filePath

Две переменные с Date в название строк. Может быть, дата не означает, что она делает на английском, но опять же - что это i там?

Вы также никогда не использовать forme1 или test.

Стандартные соглашения об именах в VBA есть camelCase для локальных переменных и PascalCase для других переменных и имена.

На английском я бы в конечном итоге с чем-то подобным

Dim filePath As String
Dim fileName As String
Dim alternateFileName As String
Dim lastRow As Long
Dim targetWorkbook As Workbook
Dim targetSheet As Worksheet
Dim index As Long
dim tempString as String

Мой tempString не может быть хорошее имя для вашего h но ваш h не говори мне, что это такое.

Кроме того, листы имеют CodeName свойства - просмотр свойств окна (Ф4) и (Name) поля (в верхней части) может быть использован как имя листа. Таким образом, вы можете избежать Sheets("Input Vektor") и вместо того, чтобы просто использовать inputVektor.


С блока

Вы просто хватают некоторые значения из листа здесь, но вы делаете это один раз. Если у вас больше данных, тебе будет лучше с массивом

Dim fileData As Variant
filedata = inputVecktorSheet.Range("C3:C4")

Затем вы можете просто получать информацию с fileData(1) или что-то. Это не имеет большого значения в данном случае, но это может стать одним.

Но, говоря о массивах

Вы, вероятно, может тянуть много это в массив, но я оставлю это до вас.


На Следующий


For i = 19 To tblRow
If IVsh.Cells(i, 7).Value <> "" Then
Exit For
End If
h = IVsh.Cells(i, 2).Formula
If InStr(1, h, "[") > 0 Then
IVsh.Cells(i, 2).Formula = "=" & Pfad & DateiName & Mid(h, InStr(1, h, "]") + 1)
Else
IVsh.Cells(i, 2).Formula = "=" & Pfad & DateiName_alt & Mid(h, InStr(1, h, "xlsx") + 4)
End If
Next i

Давайте игнорировать, что ты делаешь это все на листе вместо массива. Ваш первый If блок может быть сокращен как

If inputVektorSheet.Cells(index, CHECK_ROW).Length > 0 Then Exit For

Ах, да, я сделал некоторые константы. Они гораздо легче иметь дело с

Const CHECK_ROW As Long = 7
Const FORMULA_ROW As Long = 2
Const START_BRACKET As String = "["
Const END_BRACKET As String = "]"
Const FORMULA_START As String = "="
Const EXCEL_FILE_EXTENTION As String = "xlsx"
Dim tempFormula As String
For index = 19 To tblRow
filePath = FORMULA_START & filePath
If inputVektorSheet.Cells(index, CHECK_ROW).Length > 0 Then Exit For
tempString = inputVektorSheet.Cells(index, FORMULA_ROW).Formula
If InStr(1, tempString, START_BRACKET) > 0 Then
tempFormula = filePath & fileName & Mid(tempString, InStr(1, tempString, END_BRACKET) + 1)
Else
tempFormula = filePath & alternateFileName & Mid(tempString, InStr(1, tempString, EXCEL_FILE_EXTENTION) + 4)
End If
inputVektorSheet.Cells(index, FORMULA_ROW).Formula
Next i

Но, почему вы покинули весь цикл, если вы попали на пустую ячейку? Не все ячейки, цель иметь значение? И если они не делают, просто прекратить все это? Может быть лучше с некоторой погрешностью, а не обращение.

И, подожди, что это


DateiName_alt = DateiName

Так, что может быть слишком сочетается?

 filePath = FORMULA_START & filePath & fileName

И вы можете избавиться от _alt переменной. Я на самом деле не вижу вы используете _alt переменная на всех.


Если Блоки

Как я уже сказал, Многие из ваших блоков можно сократить до одной строки

If Mid(Pfad, Len(Pfad) - 1, 1) <> "\" Then Pfad = Pfad & "\"
If Mid(Pfad, 1, 1) <> "'" Then Pfad = "'" & Pfad
If Mid(DateiName, 1, 1) <> START_BRACKET Then DateiName = START_BRACKET & DateiName & END_BRACKET


Комментарии - "код сказать вам, как, комментарии, скажу вам, почему". Код должен говорить сам за себя, если он нуждается в комментариях, его нужно сделать более четким. Если нет, то комментарий должен описывать , почему вы делаете что-то, а не как ты делаешь это. Вот несколько причин , чтобы избежать замечаний все вместе.

1
ответ дан 14 марта 2018 в 03:03 Источник Поделиться

Попробуйте добавить Application.Calculation = xlManual когда вы включите обновление выключить, а затем включить его обратно xlAutomatic в конце.

Кроме того, поворот событий отключить (и снова включить): Application.EnableEvents = False и Application.EnableEvents = True.

Я подозреваю, что каждый раз, когда вы измените имя файла в ячейке, книга пытается получить доступ к ссылке и обновление клеток.

Небольшой момент - не влияет на скорость:

If Mid(DateiName, 1, 1) <> "[" Then
DateiName = "[" & DateiName
DateiName = DateiName & "]"
End If

может быть

If Mid(DateiName, 1, 1) <> "[" Then
DateiName = "[" & DateiName & "]"
End If

Вместо Set wb = ActiveWorkbookвы могли бы использовать ThisWorkbook - это немного более жесткую, если это то, что вам нужно. У меня нет контекста о том, как эта функция используется, поэтому он может быть вызван когда другая книга активна.

1
ответ дан 13 марта 2018 в 06:03 Источник Поделиться

Главное, что тебя тормозит-это количество операций чтения/записи. Ты гораздо лучше чтения/записи данных/формул все сразу; это намного быстрее, чтобы цикл через массив, чем цикл через ячейки. Эта версия должна быть существенно быстрее:

'Get array of values that you're checking for blanks
Dim checkBlanksArr As Variant
checkBlanksArr = IVsh.Range(IVsh.Cells(19, 7), IVsh.Cells(tblRow, 7)).Value

'Get array of existing formulas to modify
Dim formulaRng As Range
Dim formulaArr As Variant
Set formulaRng = IVsh.Range(IVsh.Cells(19, 2), IVsh.Cells(tblRow, 2))
formulaArr = formulaRng.Formula

'Edit formulas
Dim fText As String
Dim i As Long
For i = LBound(formulaArr, 1) To UBound(formulaArr, 1)
If checkBlanksArr(i, 1) = "" Then
fText = formulaArr(i, 1)
If InStr(fText, "[") > 0 Then
formulaArr(i, 1) = "=" & Pfad & DateiName & Mid(fText, InStr(fText, "]") + 1)
Else
formulaArr(i, 1) = "=" & Pfad & DateiName_alt & Mid(fText, InStr(fText, "xlsx") + 4)
End If
Else
'Exiting here seems odd to me, but I can't say for sure without seeing the worksheet
Exit For
End If
Next

'Write new formulas to range
formulaRng.Formula = formulaArr

Редактировать: только что заметил в комментарии на другой ответ, что ОП делали нечто подобное, и он действительно сделал вещи намного быстрее.

0
ответ дан 15 марта 2018 в 06:03 Источник Поделиться