VBA Преобразование из текста в excel Форматирование ячеек изменяется от общего к числовому для некоторых строк

Question

У меня есть код, который сравнивает две папки (textFiles & ExcelFiles), чтобы найти, все ли текстовые файлы преобразуются в Excel. Если нет, он вызывает функцию, которая делает это. Все работает хорошо, но когда я открываю файл Excel, формат может меняться от строки к другой в том же столбце.

Это мой код:

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 

Это картина:

Общие изменения формата ячейки для некоторых записей и становится число ехр: 4'927'027.00 должен быть 4927027, как и другие. это строки текстового файла

И я хочу поставить MsgBox, когда нет файлов для преобразования в функции «LookForNew», но я не знаю, где.

Answer 1

Вопрос 1: Открываем файл Excel, формат может меняться от строки к другой в том же столбце. Вероятно, проблема заключается в вашем текстовом файле. Обратите внимание на то, что строка, столбец и значение не отформатированы должным образом. Затем перейдите к этой строке и столбцу в текстовом файле. Скорее всего, вы увидите 4 927 027 или «4927027». В любом случае Excel может ошибочно принять его за строковое значение.

Вопрос 2: Я хочу установить msgBox, когда нет файлов для преобразования в функцию «LookForNew», но я не знаю, где.

Положите счетчик в ваши файлы If Files Exist. У вас должен быть MsgBox после выхода из цикла файлов. - Следующий фил

Эта линия мисс ведущий:

oFileExcel.Add dExcel, "ключ"

правильный синтаксис

dictionary.add ключ, значение

Ключи являются уникальными идеями ntifiers. Перед тем, как добавить ключ в словарь, вы должны проверить, чтобы увидеть, если ключ существует

Если не oFileExcel.Exists dExcel тогда oFileExcel.Add dExcel «»

Значения ссылки на объекты или значения ,

Эта строка добавляет объект файла EXL словарю oFileExcel

Если не oFileExcel.Exists dExcel тогда oFileExcel.Добавить dExcel, EXL

Эта строка возвращает значение

Set EXL = oFileExcel ("SomeKey")

Ошибка бросают, потому что вы добавляете один и тот же ключ дважды. Ключевыми значениями являются имя файла Excel без расширения. Example.xls и Example.xlsx выдаст тот же ключ.

Это, как говорится, не нужно использовать словарь. Или сделать цикл файла в tgr().
я лучше подход был бы

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 

Здесь шаблон стартера

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