VBA 脚本/清理/删除硬空格/删除科学的“E+”符号/并保存为 Unicode 文本

问题描述 投票:0回答:1

首先,我不是 VBA 脚本或编码方面的专家,但我每天所做的就是接收 excel 文件,在这些文件中我不应该只是为了清理它们而编辑其中的数据(还有所有 excel 中的工作表)文件)并将它们保存为 Unicode 文本文件,需要做的是使用 clean 函数(最好在所有列上)删除硬间距和任何导致换行的内容以及科学的“E+”符号,而不影响列中的数据(这可能包括日期、值和描述)

我已经创建了这个,但它冻结在大的 Excel 文件上,而且只清理和保存我认为的部分,所以它并不总是 100% 干净

Sub CleanAndSaveEachSheetAsUnicodeText()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim lastRow As Long
    Dim lastCol As Long
    Dim originalPath As String
    Dim fileName As String
    Dim data As Variant
    Dim i As Long, j As Long
    
    ' Disable screen updating and automatic calculation
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' Loop through each worksheet in the workbook
    For Each ws In ThisWorkbook.Sheets
        ' Find the last row and last column with data in the worksheet
        lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
        lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
        
        ' Load data into an array
        data = ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol)).Value
        
        ' Loop through the array to apply the CLEAN function
        For i = 1 To UBound(data, 1)
            For j = 1 To UBound(data, 2)
                data(i, j) = Application.Clean(data(i, j))
            Next j
        Next i
        
        ' Write cleaned data back to the worksheet
        ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastCol)).Value = data
        
        ' Get the original file path and name
        originalPath = ThisWorkbook.FullName
        
        ' Extract the sheet name
        fileName = ws.Name
        
        ' Save the worksheet as Unicode text in the same folder as the original file
        Dim filePath As String
        filePath = Application.GetSaveAsFilename(InitialFileName:=fileName, FileFilter:="Unicode Text (*.txt), *.txt", Title:="Save As")
        
        If filePath <> "False" Then
            ' Save as Unicode text
            ws.SaveAs Filename:=filePath, FileFormat:=xlUnicodeText
        End If
    Next ws
    
    ' Enable screen updating and automatic calculation
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

如果有人可以帮助我完成它并为我修复代码,我将非常感激

excel vba scientific-notation
1个回答
0
投票

无需循环单个单元格即可应用

CLEAN
功能。同样,您可以将硬空间
chr(160)
转换为普通空间。
然而,你想要用科学记数法做的是你必须精确地描述并准确地陈述你拥有什么和你需要拥有什么。
具有建议改进的代码片段:

 ' Get the original file path and name
originalPath = ThisWorkbook.FullName

' Loop through each worksheet in the workbook
For Each ws In ThisWorkbook.Sheets

' Load data into an array
data = ws.UsedRange.Value

' apply the CLEAN function
 data = Application.Clean(data)

'  apply SUBSTITUTE to change chr(160) to chr(32)
 data = Application.Substitute(data, Chr(160), " ")

' Write cleaned data back to the worksheet
  ws.UsedRange.Value = data
© www.soinside.com 2019 - 2024. All rights reserved.