次のコードに問題があります。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
2番目のコード
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 数式は別のシートからデータをインポートするために使用されるため、データを 1 つずつ入力する必要はありません。クリーン ファイルを変更して 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
写真を見る新しいエラー
要求された16進コードも見つけてください
コードを次のように変更しました
Else sz = txtLen + 3
しかし、まだエラー76が添付されていますエラー 76 デバッグはこの行を指しています。
Open FULL_PATH For Input As fId
答え1
サブルーチンによって実際に数式 (それが何であれ) が (完全に) 削除されるとCleanUsedRange()は思いませんが、特定の文字が削除されるため、数式が破壊される可能性があります。CleanFileName()VlookCleanFileName()
現在のコードがなぜ問題を引き起こすのかを説明するために、いくつかの行を分析してみましょう。
では、 をCommandButton2_Click()呼び出しますCleanUsedRange ws.UsedRange。ここで、wsは を参照し"Sheet1"、UsedRangeの使用範囲を表しますws。これは、コンテンツ (データや数式など) がある (またはあった) 最初と最後の列 (両端を含む) と最初と最後の行 (両端を含む) の間のセルの範囲を意味します。
では、CleanUsedRange()使用範囲 ( として渡される) のすべてのセル (各行と列) を走査しur As Range、CleanFileName()これらすべてのセルの内容を呼び出しています。この関数 ( CleanUsedRange()) は、ワークシート内の数式を文字列として関数に渡すため、数式が破壊される主な原因ですCleanFileName()。
ではCleanFileName()、渡された引数にファイル名に無効な文字が含まれていないかチェックされます。その後、変更された引数が関数の結果として返されます。
修正: 使用範囲全体をCleanUsedRange()およびに渡さないでくださいCleanFileName()。実際には、サブルーチンを完全に削除できますCleanUsedRange()。
クリーニングが必要な可能性があるファイル名を含む 1 つのセル (C10 ?) のみを に渡しますCleanFileName()。
つまり、CommandButton2_Click()代わりに
CleanUsedRange ws.UsedRange
と
Range("C10") = CleanFileName(Range("C10")).
(セルC10には使用するファイル名が保持されていると仮定します。)
「四角で囲まれた疑問符」に関する編集
「四角で囲まれた疑問符」の問題については、.pdfExcel で作成されたファイルでは、コードが 32 未満の文字はすべて問題を引き起こすことがわかりました (私の Excel では、Chr(12) のみが「四角で囲まれた疑問符」として表示されます)。明らかに、各フィールドの間にはそのような文字が 2 つあり、その文字は「キャリッジ リターン - ライン フィード」(CRLF) のペアである可能性が高いのですが、その情報はまだ提供されていないため、それを確認できるのはあなただけです。
文字列から値を読み取るときは、txt次のコードを使用します。
.Range(d(k)).Value2 = Trim$(Mid$(txt, found, sz - found - 1))
それを次のように変更する
.Range(d(k)).Value2 = Trim$(Mid$(txt, found, sz - found - 2))
コメントで提案したように、問題は解決します。
エラーに関する編集 2018年7月8日
まず、ファイルをありがとうございます。ファイル内のフィールド間の CRLF ペアに関する私の疑念が明確に確認されました。また、関数で抽出するデータの長さはMid$()1 ではなく 2 に減らす必要があることも確認されました。
以前の変更で発生したエラーを再現することはできませんでしたが、最後のフィールド (「日付」) にはまだエラーが 1 つあります。これはおそらく、お客様の環境でエラーとして発生しているもので、私の環境では発生していませんが、年が誤って 201 と表示されています。
最後のフィールドのエラーは、szデータ抽出で行った以前の変更 (sz - found - 1に変更しましたsz - found - 2) を補正するために変数を増やす必要があることです。
だから、変えよう
Else sz = txtLen + 2
に
Else sz = txtLen + 3
もちろん、これは、ファイルの最後のフィールド (「日付」) の読み取り時にエラーが発生した場合にのみ役立ちます。これが役に立たない場合は、デバッグして、どのフィールドを読み取っているか、および失敗したときに変数k、found、 がどのような値を持っszているかをお知らせください。また、表示される可能性のあるポップアップ メッセージについてもお知らせください。