VBA Konvertieren von Text in Excel Format Zellen ändern von Allgemein zu Numerisch für einige Zeilen

Question

Ich habe Code, der zwei Ordner vergleicht (Textdateien & ExcelFiles), um zu finden, wenn alle TextFiles nach Excel konvertiert werden. Wenn nicht, ruft es eine Funktion auf, die dies tut. Alles funktioniert gut, aber wenn ich die Excel-Datei öffne, kann sich das Format von einer Reihe zu einer anderen in derselben Spalte ändern.

Dies ist mein Code:

Die allgemeinen Format Zellveränderungen für einige Datensätze und wird zu einer Zahl exp: 4'927'027.00 sollte

Sub LookForNew() 
Dim dTxt As String, dExcel As String, key As String 
Dim i As Integer 
Dim oFileExcel, tFileExl, oFileExl, fso, filsTxt, filsExcel, fil, exl 
Set fso = CreateObject("Scripting.FileSystemObject") 
Set filsTxt = fso.GetFolder("C:\txtFiles").Files 
Set filsExcel = fso.GetFolder("C:\excelFiles").Files 
Set oFileExcel = CreateObject("Scripting.Dictionary") 
Set tFileExl = CreateObject("Scripting.Dictionary") 
Set oFileExl = CreateObject("Scripting.Dictionary") 
i = 0 

    For Each fil In filsTxt 
     dTxt = fil.Name 
     dTxt = Left(dTxt, InStr(dTxt, ".") - 1) 

      For Each exl In filsExcel 
       dExcel = exl.Name 
       dExcel = Left(dExcel, InStr(dExcel, ".") - 1) 
       key = CStr(i) 
       oFileExcel.Add dExcel, "key" 
       i = i + 1 
      Next exl 

      If Not (oFileExcel.Exists(dTxt)) Then 
        Call tgr 
      End If    
    Next fil 
Set fso = Nothing 
End Sub 

Sub tgr() 

Const txtFldrPath As String = "C:\txtFiles"  
Const xlsFldrPath As String = "C:\excelFiles"  
Dim CurrentFile As String: CurrentFile = Dir(txtFldrPath & "\" & "*.txt") 
Dim strLine() As String 
Dim LineIndex As Long 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
While CurrentFile <> vbNullString 
    LineIndex = 0 
    Close #1 
    Open txtFldrPath & "\" & CurrentFile For Input As #1 
While Not EOF(1) 
    LineIndex = LineIndex + 1 
    ReDim Preserve strLine(1 To LineIndex) 
    Line Input #1, strLine(LineIndex) 
    'STRIP TABS OUT AND REPLACE WITH A SPACE!!!!! 
    strLine(LineIndex) = Replace(strLine(LineIndex), Chr(9), Chr(32)) 
Wend 
Close #1 

    With ActiveSheet.Range("A1").Resize(LineIndex, 1) 
    .Value = WorksheetFunction.Transpose(strLine) 
    'DEFINE THE OPERATION FULLY!!!! 
    .TextToColumns Destination:=.Cells(1), DataType:=xlDelimited, _ 
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _ 
        Tab:=False, Semicolon:=False, Comma:=False, Space:=False, _ 
        Other:=True, OtherChar:="|" 
End With 

    ActiveSheet.UsedRange.EntireColumn.AutoFit 
    ActiveSheet.Copy 
    ActiveWorkbook.SaveAs xlsFldrPath & "\" & Replace(CurrentFile, ".txt", ".xlsx"), xlOpenXMLWorkbook 
    ActiveWorkbook.Close False 
    ActiveSheet.UsedRange.ClearContents 

    CurrentFile = Dir 
Wend 
Application.DisplayAlerts = True 
Application.ScreenUpdating = True  
End Sub 

Dies ist das Bild Sei 4927027 wie die anderen. diese ist die Textdatei Zeilen

Und ich möchte eine MSGBOX setzen, wenn es keine Dateien ist in „LookForNew“ -Funktion zu konvertieren, aber ich weiß nicht, wo.

Answer 1

Frage 1: Ich öffne die Excel-Datei, das Format kann von einer Reihe zu einer anderen in der gleichen Spalte ändern. Antwort: Das Problem liegt wahrscheinlich in Ihrer Textdatei. Notieren Sie, welche Zeile, Spalte und Wert nicht richtig formatiert ist. Als nächstes gehen Sie zu dieser Zeile und Spalte in Ihrer Textdatei. Sie werden wahrscheinlich 4.927.027 oder "4927027" sehen. In beiden Fällen könnte Excel es für einen Zeichenfolgenwert verwechseln.

Frage 2: Ich möchte eine msgBox setzen, wenn es keine Dateien in "LookForNew" -Funktion zu konvertieren gibt, aber ich weiß nicht wo.

Setzen Sie einen Zähler in Ihre If-Dateien vorhanden. Sie sollten Ihre MsgBox haben, nachdem Sie Ihre Dateischleife beendet haben. - Weiter fil

Diese Linie Miss führt:

oFileExcel.Add Dexcel, "Schlüssel"

korrekte Syntax

dictionary.add Schlüssel, Wert

Schlüssel sind einzigartig ide ntifiers. Bevor Sie einen Schlüssel zu einem Wörterbuch hinzufügen sollten Sie testen, ob der Schlüssel

Wenn nicht oFileExcel.Exists Dexcel dann oFileExcel.Add Dexcel existieren „“

Werte Verweise auf Objekte oder Werte .

Diese Zeile fügt die EXL Dateiobjekt oFileExcel Wörterbuch

Wenn nicht oFileExcel.Exists Dexcel dann oFileExcel.In Dexcel, EXL

Diese Linie dem Wert

Sets EXL = oFileExcel ("somekey")

Der Fehler ausgelöst wird, weil Sie die gleiche Taste zweimal hinzufügen abruft. Die Schlüsselwerte sind der Name der Excel-Datei ohne Erweiterung. Example.xls und Example.xlsx erzeugen denselben Schlüssel.

Das besagt, es besteht keine Notwendigkeit, ein Wörterbuch zu verwenden. Oder um eine Dateischleife in tgr() zu machen.
Ich würde besser Ansatz

sein Hier

Sub Main 

    For each textfile 

    basename = get text file basename 

    xlfile = xlFileDirectory + baseFileName + excel file extension 

    if not xlfile Exists then call CreateExcelFromTxt f.Path, xlFileName 

End Sub 

Sub CreateExcelFromTxt(txtFile, xlFileName) 

    Open txtFile 

    Build strLine 

    Create Excel -> xlFileName 

    Add strLine to xlFileName 

    run TextToColumns 

End Sub 

ist ein Starter-Vorlage

Sub LookForNew() 
 
\t Const xlFileDirectory = "C:\excelFiles\" 
 
\t Const txtFileDirectory = C:\txtFiles\" 
 
\t Application.DisplayAlerts = False 
 
\t Application.ScreenUpdating = False \t 
 
\t 
 
\t Dim fso, fld , f, xlFileName 
 
\t Set fso = WScript.CreateObject("Scripting.Filesystemobject") 
 
\t Set fld = fso.GetFolder(txtFileDirectory) 
 
\t 
 
\t Set txtFiles = fso.GetFolder(txtFileDirectory).Files 
 
\t For Each f In txtFiles 
 
\t \t baseFileName = Left(f.Name,InStrRev(f.Name,".")-1) 
 
\t \t xlFilePath = xlFileDirectory & baseFileName & ".xlsx" 
 
\t \t If Not fso.FileExists(xlFilePath) Then CreateExcelFromText f.Path, xlFileName 
 
\t Next 
 
\t 
 
\t Application.DisplayAlerts = True 
 
\t Application.ScreenUpdating = True 
 
End Sub 
 

 

 
Sub CreateExcelFromText(txtFileName, xlFileName) 
 

 
End Sub