☰

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()子系統。

僅將包含可能需要清理的檔案名稱的一個儲存格（C10？）傳遞到CleanFileName().

IOW，CommandButton2_Click()替換

CleanUsedRange ws.UsedRange

和

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

（假設儲存格C10保存要使用的檔案名稱。）

關於「盒裝問號」的編輯

對於「盒裝問號」的問題，我發現任何代碼小於32的字元都會在.pdfExcel產生的檔案中產生問題（在我的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另請告知可能顯示的任何彈出訊息。

相關內容