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。 - 下一个fil

此行未通过：

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

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

1 个答案: