VBA CleanFileName 和 CleanUsedRange

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 - 1sz - found - 2)。

因此,改变

Else sz = txtLen + 2

Else sz = txtLen + 3

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

相关内容