У меня возникла проблема со следующим кодом. Всякий раз, когда я запускаю код vba, код CleanFileName и CleanUsedRange удаляет мои формулы Vlook.
Есть ли способ использовать CleanFileName и CleanUsedRange без удаления формул vlook? Коды приведены ниже.
Private Sub CommandButton1_Click()
Const FULL_PATH = "C:\Documents\test\quot.txt"
Dim fId As String, txt As String, txtLen As Long, d As Object, dc As Long
fId = FreeFile
Open FULL_PATH For Input As fId
txt = Input(LOF(fId), fId) 'Read entire file (not line-by-line)
Close fId
txtLen = Len(txt)
Set d = CreateObject("Scripting.Dictionary")
d("Name") = "C11" 'Same as: d.Add Key:="Name", Item:="C11"
d("Phone") = "H13"
d("Address1") = "C15"
d("Email") = "C13"
d("Postcode") = "H16"
d("SR") = "C10"
d("MTM") = "H14"
d("Serial") = "H15"
d("Problem") = "C17"
d("Action") = "C18"
d("Dated") = "H10"
dc = d.Count
Dim i As Long, k As String, sz As Long, found As Long
With ThisWorkbook.Worksheets("Sheet1") '<--- Update sheet name
For i = 0 To dc - 1 'd.Keys()(i) is a 0-based array
k = d.Keys()(i) 'Name, Phone, etc
found = InStr(txt, k) + Len(k) + 1 'Find the (first) key in file
If found > 0 Then 'Determine item length by finding the next key
If i < dc - 1 Then sz = InStr(txt, d.Keys()(i + 1)) Else sz = txtLen + 2
.Range(d(k)).Value2 = Trim$(Mid$(txt, found, sz - found - 1))
End If
Next
End With
End Sub
ЧистыйФайл
Public Function CleanFileName(ByVal fName As String) As String
Dim b() As Byte, specialChars As Variant, i As Long
b = "\/:*?|<>" & Chr(34) & Chr(8) & Chr(9) & Chr(10) & Chr(13)
specialChars = Split(StrConv(b, vbUnicode), Chr(0))
fName = Trim$(fName) 'Trim, then remove \ / : * ? | < > " Backspace Tab LF CR
For i = 0 To UBound(specialChars)
fName = Replace(fName, specialChars(i), vbNullString)
Next
CleanFileName = fName
End Function
Второй код
Public Sub CleanUsedRange(ByRef ur As Range)
Dim arr As Variant, r As Long, c As Long
arr = ur.Formula
For r = 1 To UBound(arr, 1)
For c = 1 To UBound(arr, 2)
arr(r, c) = CleanFileName(arr(r, c))
Next
Next
ur.Formula = arr
End Sub
Экспортный код
Private Sub CommandButton2_Click()
Dim ws As Worksheet, fPath As String, fName As String, dt As String
Set ws = ThisWorkbook.Worksheets("Sheet1")
fPath = "C:\Documents\test\"
dt = Format(Date, " - MM-DD-YYYY")
CleanUsedRange ws.UsedRange
fName = fPath & ws.Range("C10") & dt & " - Quotation"
ws.Range("A1:I60").ExportAsFixedFormat Type:=xlTypePDF, FileName:=fName
End Sub
Формулы Vlook используются для импорта данных с другого листа, так что не нужно вводить их по одному. Есть ли способ изменить cleanfile так, чтобы не удалять формулы vlook.
После редактирования кода, как вы предложили
Private Sub CommandButton2_Click()
Dim ws As Worksheet, fPath As String, fName As String, dt As String
Set ws = ThisWorkbook.Worksheets("Sheet1")
fPath = "C:\Users\Documents\test\\"
dt = Format(Date, " - MM-DD-YYYY")
Range("C10") = CleanFileName(Range("C10"))
fName = fPath & ws.Range("C10") & dt & " - Quotation"
ws.Range("A1:I60").ExportAsFixedFormat Type:=xlTypePDF, FileName:=fName
End Sub
Однако экспортированный файл, похоже, содержит иностранные символы, как показано ниже.
Есть ли другое решение?
Я изменил код, как вы предложили, но я не могу запустить VBA. После добавления этого:
.Range(d(k)).Value2 = Trim$(Mid$(txt, found, sz - found - 2))
Вот куда указывает ошибка
Open FULL_PATH For Input As fId
Смотреть картинкуновая ошибка
Также найдите шестнадцатеричный код, который вы запросили.
Я изменил код на
Else sz = txtLen + 3
Однако я все еще получаю сообщение об ошибке 76.Ошибка 76 И отладка указывает на эту строку;
Open FULL_PATH For Input As fId
решение1
Я не думаю, что ваши подписчики CleanUsedRange()на CleanFileName()самом деле удаляют (полностью) ваши Vlookформулы (какими бы они ни были), но ваши формулы могут быть уничтожены, CleanFileName()поскольку они удаляют определенные символы.
Чтобы объяснить, почему ваш текущий код создает проблемы, давайте проанализируем несколько строк:
В CommandButton2_Click()вы вызываете CleanUsedRange ws.UsedRange. Здесь wsотносится к "Sheet1"и UsedRangeпредставляет используемый диапазон ws, то есть диапазон ячеек между первым и последним столбцами (включительно) и первой и последней строками (включительно), которые имеют (или имели) содержимое (например, данные или формулы).
В CleanUsedRange()вы проходите по всем ячейкам (каждой строке и столбцу) используемого диапазона (переданного как ur As Range) и вызываете CleanFileName()содержимое всех этих ячеек. Эта функция ( CleanUsedRange()) является основной причиной уничтожения ваших формул, поскольку она передает формулы на вашем рабочем листе в функцию как строки CleanFileName().
В CleanFileName(), переданный аргумент проверяется на наличие определенных символов, которые недопустимы в именах файлов. Затем измененный аргумент возвращается как результат функции.
Исправление: Не передавайте весь используемый диапазон в CleanUsedRange()и CleanFileName(). Фактически, вы можете полностью отказаться от CleanUsedRange()подпрограммы.
Передайте в . только одну ячейку (C10 ?), содержащую имя файла, который может нуждаться в очистке CleanFileName().
IOW, в CommandButton2_Click()замене
CleanUsedRange ws.UsedRange
с
Range("C10") = CleanFileName(Range("C10")).
(Предполагается, что ячейка C10содержит имя файла, который будет использоваться.)
Редактировать относительно «вопросительных знаков в рамке»
Что касается проблемы с «вопросительными знаками в рамке», я обнаружил, что любой символ с кодом меньше 32 вызывает проблему в .pdfфайле, созданном Excel (в моем Excel только Chr(12) отображается как «вопросительный знак в рамке»). Очевидно, что между каждым полем есть два таких символа, и вероятными из них являются пара «возврат каретки — перевод строки» (CRLF), но подтвердить это можете только вы, поскольку вы еще не предоставили эту информацию.
При считывании значений из txtстроки используется следующий код:
.Range(d(k)).Value2 = Trim$(Mid$(txt, found, sz - found - 1))
Изменить его на
.Range(d(k)).Value2 = Trim$(Mid$(txt, found, sz - found - 2))
как я и предположил в комментарии, решает проблему.
Редактировать относительно ошибки 7.8.2018
Во-первых, спасибо за файл. Он четко подтверждает мои подозрения о паре CRLF между полями в файле. Он также подтверждает, что длина данных, которые мы извлекаем с помощью функции, Mid$()должна быть уменьшена на 2 вместо 1.
Мне не удалось воспроизвести ошибку, которую вы испытали с предыдущей модификацией, но действительно есть одна ошибка с последним полем ("Dated"). Возможно, это вызывает ошибку в вашей среде, в моей нет, но год ошибочно отображается как 201.
Ошибка с последним полем заключается в том, что szпеременная должна увеличиться, чтобы компенсировать предыдущее изменение, которое мы сделали при извлечении данных (мы изменили sz - found - 1на sz - found - 2).
Итак, изменение
Else sz = txtLen + 2
к
Else sz = txtLen + 3
Конечно, это помогает только в том случае, если ошибка возникает при чтении последнего поля ("Dated") файла. Если это не помогает, пожалуйста, выполните отладку и сообщите мне, какое поле вы читаете и какие значения имеют переменные k, foundи szкогда происходит сбой. Также сообщите о любых всплывающих сообщениях, которые могут отображаться.