VBA从文本转换为excel格式单元格从常规更改为某些行的数字

Question

我有比较两个文件夹（textFiles 和 ExcelFiles）的代码，以确定是否所有 textFiles 都转换为 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

这是图片：

一些记录的通用格式单元格发生变化，变成一个数字 exp：4'927'027.00 应该是 4927027 和其他的一样。 这是文本文件行

我想在“LookForNew”函数中没有要转换的文件时放一个msgBox，但我不知道在哪里。

Answer 1

问题 1： 我打开 Excel 文件，格式可能会在同一列中从一行变为另一行。 答案：问题可能出在您的文本文件中。请注意哪些行、列和值的格式不正确。接下来转到文本文件中的该行和列。您很可能会看到 4,927,027 或“4927027”。无论哪种情况，Excel 都可能将其误认为是字符串值。

问题 2： 我想在“LookForNew”函数中没有要转换的文件时放置一个 msgBox，但我不知道在哪里。

在您的 If Files Exist 中放置一个计数器。退出文件循环后，您应该拥有 MsgBox。 - 下一个文件

此行未领先：

oFileExcel.Add dExcel, "key"

正确的语法

dictionary.add 键、值

键是唯一标识符。在向字典添加键之前，您应该测试该键是否存在

如果不是 oFileExcel.Exists dExcel 那么 oFileExcel.Add dExcel, ""

值是对对象或值的引用。

这一行将 exl 文件对象添加到 oFileExcel 字典中

如果不是 oFileExcel.Exists dExcel 那么 oFileExcel.Add dExcel, exl

此行检索值

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


Sub CreateExcelFromText(txtFileName, xlFileName)

End Sub