☰

VBA CleanFileName 和 CleanUsedRange

tag-icon • tag-icon microsoft-excel worksheet-function vba
VBA CleanFileName 和 CleanUsedRange

我对以下代码有些问题。每当我运行 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

但是，导出的文件似乎有外来符号，如下所示

图片1

图片2

还有其他解决办法吗？

我按照您的建议更改了代码，但无法运行 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()完全放弃 sub 。

仅将包含可能需要清理的文件名的一个单元格（C10？）传递到CleanFileName()。

CommandButton2_Click()换句话说，

CleanUsedRange ws.UsedRange

和

Range("C10") = CleanFileName(Range("C10")).

（假设单元格C10保存要使用的文件名。）

关于“方框问号”的编辑

对于“方框问号”的问题，我发现在.pdfExcel 生成的文件中，任何代码小于 32 的字符都会产生问题（在我的 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。

我无法重现您在之前修改时遇到的错误，但最后一个字段（“日期”）确实仍存在一个错误。这可能是您环境中的错误，但在我的环境中不是，但年份错误地显示为 201。

最后一个字段的错误是sz变量需要增长以补偿我们之前在数据提取中所做的更改（我们将其更改sz - found - 1为sz - found - 2）。

因此，改变

Else sz = txtLen + 2

到

Else sz = txtLen + 3

当然，这仅在读取文件的最后一个字段（“日期”）时发生错误时才有用。如果这没有帮助，请进行调试并让我知道您正在读取哪个字段以及变量k、found和的值sz在失败时是什么。还请告知可能显示的任何弹出消息。

相关内容