Ich habe ein Problem mit dem folgenden Code. Immer wenn ich den VBA-Code ausführe, löschen die Codes CleanFileName und CleanUsedRange meine Vlook-Formeln.
Gibt es eine Möglichkeit, CleanFileName und CleanUsedRange zu verwenden, ohne die Vlook-Formeln zu löschen? Die Codes finden Sie unten.
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
Die CleanFile
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
Zweiter Code
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
Der Exportcode
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
Die Vlook-Formeln werden verwendet, um Daten aus einem anderen Blatt zu importieren, sodass man sie nicht einzeln eingeben muss. Gibt es eine Möglichkeit, die Cleanfile so zu ändern, dass die Vlook-Formeln nicht entfernt werden?
Nachdem Sie den Code wie vorgeschlagen bearbeitet haben
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
Die exportierte Datei scheint jedoch Fremdsymbole zu enthalten, wie unten
Irgendeine andere Lösung?
Ich habe den Code wie vorgeschlagen geändert, kann VBA jedoch nicht ausführen. Nachdem ich Folgendes hinzugefügt habe:
.Range(d(k)).Value2 = Trim$(Mid$(txt, found, sz - found - 2))
Hier liegt der Fehler
Open FULL_PATH For Input As fId
Siehe Bildneuer Fehler
Finden Sie auch den Hex-Code u angefordert
Ich habe den Code geändert in
Else sz = txtLen + 3
Allerdings erhalte ich immer noch den Fehler 76Fehler 76 Und der Debug zeigt auf diese Zeile;
Open FULL_PATH For Input As fId
Antwort1
Ich glaube nicht, dass Ihre Untertitel CleanUsedRange()Ihre Formeln (was auch immer sie sind) CleanFileName()tatsächlich (vollständig) löschen Vlook, aber Ihre Formeln könnten dadurch zerstört werden, CleanFileName()da bestimmte Zeichen entfernt werden.
Um zu erklären, warum Ihr aktueller Code Probleme verursacht, analysieren wir ein paar Zeilen:
In CommandButton2_Click()rufen Sie auf CleanUsedRange ws.UsedRange. Dabei wsbezeichnet "Sheet1"und UsedRangestellt den verwendeten Bereich von dar ws, also den Bereich der Zellen zwischen der ersten und letzten Spalte (einschließlich) und der ersten und letzten Zeile (einschließlich), die Inhalt haben (oder hatten) (z. B. Daten oder Formeln).
In CleanUsedRange()durchlaufen Sie alle Zellen (jede Zeile und Spalte) des verwendeten Bereichs (übergeben als ur As Range) und rufen CleanFileName()den Inhalt aller dieser Zellen auf. Diese Funktion ( CleanUsedRange()) ist der Hauptgrund für die Zerstörung Ihrer Formeln, da sie die Formeln in Ihrem Arbeitsblatt als Zeichenfolgen an die Funktion übergibt CleanFileName().
In CleanFileName()wird das übergebene Argument auf bestimmte, im Dateinamen ungültige Zeichen überprüft. Das geänderte Argument wird anschließend als Ergebnis der Funktion zurückgegeben.
Lösung: Übergeben Sie nicht den gesamten verwendeten Bereich an CleanUsedRange()und CleanFileName(). Tatsächlich können Sie das CleanUsedRange()Sub vollständig weglassen.
Übergeben Sie nur die eine Zelle (C10?), die den Dateinamen enthält, der möglicherweise bereinigt werden muss, an CleanFileName().
Mit anderen Worten, als CommandButton2_Click()Ersatz
CleanUsedRange ws.UsedRange
mit
Range("C10") = CleanFileName(Range("C10")).
(Vorausgesetzt, die Zelle C10enthält den zu verwendenden Dateinamen.)
Bearbeitung bezüglich „eingerahmter Fragezeichen“
Was das Problem mit den „umrahmten Fragezeichen“ betrifft, habe ich festgestellt, dass jedes Zeichen mit einem Code kleiner als 32 das Problem in einer .pdfvon Excel erstellten Datei verursacht (in meinem Excel wird nur Chr(12) als „umrahmtes Fragezeichen“ angezeigt). Offensichtlich gibt es zwischen jedem Feld zwei solcher Zeichen, und die wahrscheinlichen sind ein Paar „Carriage Return - Line Feed“ (CRLF), aber nur Sie können das bestätigen, da Sie diese Informationen noch nicht bereitgestellt haben.
Wenn Sie die Werte aus der Zeichenfolge lesen, txtverwenden Sie diesen Code:
.Range(d(k)).Value2 = Trim$(Mid$(txt, found, sz - found - 1))
Ändern Sie es in
.Range(d(k)).Value2 = Trim$(Mid$(txt, found, sz - found - 2))
wie ich in einem Kommentar vorgeschlagen habe, behebt das das Problem.
Edit bzgl. Fehler 7.8.2018
Erstmal danke für die Datei. Sie bestätigt eindeutig meinen Verdacht bezüglich eines CRLF-Paares zwischen den Feldern in der Datei. Sie bestätigt auch, dass die Länge der Daten, die wir mit der Mid$()Funktion extrahieren, um 2 statt um 1 reduziert werden muss.
Ich konnte den Fehler, den Sie bei der vorherigen Änderung hatten, nicht reproduzieren, aber es gibt tatsächlich noch einen Fehler mit dem letzten Feld („Datum“). Möglicherweise wird das in Ihrer Umgebung als Fehler gemeldet, in meiner nicht, aber das Jahr wird fälschlicherweise als 201 angezeigt.
Der Fehler beim letzten Feld besteht darin, dass die szVariable wachsen muss, um die vorherige Änderung zu kompensieren, die wir bei der Datenextraktion vorgenommen haben (wir haben sz - found - 1zu geändert sz - found - 2).
Ändern Sie also
Else sz = txtLen + 2
Zu
Else sz = txtLen + 3
Dies hilft natürlich nur, wenn der Fehler beim Lesen des letzten Felds („Datum“) der Datei auftritt. Wenn dies nicht hilft, debuggen Sie bitte und teilen Sie mir mit, welches Feld Sie lesen und welche Werte die Variablen und haben k, wenn es fehlschlägt. Informieren Sie mich auch über eventuell angezeigte Popup-Nachrichten.foundsz