使用VBA将固定文本文件导入excel

Question

我正在使用VBA将固定文本文件导入excel文件。 我在修复列的拟合（自动调整）时也遇到了问题，还有数字的小数。

我有一个这么 5027.1202024.0000.0000.000.0000.0000.0000 的十进制数，并希望简化为5027.12，因为我的列不合适而且只是分开。还有另一种方法，除了声明几个数组并修复它的宽度？文本文件已经以某种方式修复了。 我还是vba的新手，我会尽力帮助你。感谢

修改

Option Explicit
Sub ImportPrepayment()
    Dim fpath
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim sDelimiter As String

    'Call import_TExtFileR12

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    sDelimiter = "|"

    fpath = Application.GetOpenFilename _
      (FileFilter:="Text Files (*.txt), *.txt", _
      MultiSelect:=True, Title:="Text Files to Open")

    If TypeName(fpath) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If

    x = 1
    Set wkbTemp = Workbooks.Open(FileName:=fpath(x))
    wkbTemp.Sheets(1).Copy
    Set wkbAll = ActiveWorkbook
    wkbTemp.Close (False)
    wkbAll.Worksheets(x).Columns("A:A").TextToColumns _
      Destination:=Range("A1"), DataType:=xlDelimited, _
      TextQualifier:=xlDoubleQuote, _
      ConsecutiveDelimiter:=False, _
      Tab:=False, Semicolon:=False, _
      Comma:=False, Space:=False, _
      Other:=True, OtherChar:="|"
    x = x + 1

    While x <= UBound(fpath)
        Set wkbTemp = Workbooks.Open(FileName:=fpath(x))
        With wkbAll
            wkbTemp.Sheets(1).Move After:=.Sheets(.Sheets.Count)
            .Worksheets(x).Columns("A:A").TextToColumns _
              Destination:=Range("A1"), DataType:=xlDelimited, _
              TextQualifier:=xlDoubleQuote, _
              ConsecutiveDelimiter:=False, _
              Tab:=False, Semicolon:=False, _
              Comma:=False, Space:=False, _
              Other:=True, OtherChar:=sDelimiter
        End With
        x = x + 1
    Wend


Range("A17:XFD" & x).Delete shift:=xlUp
 'Range("A1").Value = "Supplier Name"
   ' Range("C1").Value = "Supplier Number"
    'Range("D1").Value = "Inv Curr Code"
    'Range("E1").Value = "Payment Cur Code"
    'Range("F1").Value = "Invoice Type"
    'Range("G1").Value = "Invoice Number"
    'Range("H1").Value = "Voucher Number"
    'Range("I1").Value = "Invoice Date"
    'Range("J1").Value = "GL Date"
    'Range("K1").Value = "Invoice Amount"
    'Range("L1").Value = "Witheld Amount"
    'Range("M1").Value = "Amount Remaining"
    'Range("N1").Value = "Description"
    'Range("O1").Value = "Account Number"
    'Range("P1").Value = "Invoice Amt"
    'Range("Q1").Value = "Withheld Amt"
    'Range("R1").Value = "Amt Remaining"
    'Range("S1").Value = "User Name"


Call ProcessUsedRange
Columns.EntireColumn.HorizontalAlignment = xlCenter
Columns.EntireColumn.AutoFit
ExitHandler:
    Application.ScreenUpdating = True
    Set wkbAll = Nothing
    Set wkbTemp = Nothing
    Exit Sub

ErrHandler:
    If Err.Number <> 0 Then MsgBox Err.Number & " " & Err.Description
    Resume ExitHandler
End Sub
Sub ProcessUsedRange()
    Dim r As Range
    Dim regex As Object, Match As Object
    Set regex = CreateObject("VBScript.RegExp")
    With regex
        .Pattern = "\d{4}.\d{4}.\d{4}.\d{3}.\d{4}.\d{4}.\d{4}"
        .Global = True
    End With

    For Each r In ActiveSheet.UsedRange
        If regex.Test(r.Text) Then
            For Each Match In regex.Execute(r.Value)
                r.Value = "'" & Replace(r.Value, Match.Value, "")
            Next
        End If
    Next
End Sub

Answer 1

而不是使用recyclerView.getDataList().add(Person("Lem Adane", "41 years old", 0)) 或Error:(19, 31) Out-projected type 'ArrayList<*>' prohibits the use of 'public open fun add(index: Int, element: E): Unit defined in java.util.ArrayList' ;只需读取文本文件并处理数据。

TextToColumns

Answer 2

在Columns.EntireColumn.AutoFit之前添加此代码。

Sub ProcessUsedRange()
    Dim r As Range
    Dim regex As Object, Match As Object
    Set regex = CreateObject("VBScript.RegExp")
    With regex
        .Pattern = "\d{4}.\d{4}.\d{4}.\d{3}.\d{4}.\d{4}.\d{4}"
        .Global = True
    End With

    For Each r In ActiveSheet.UsedRange
        If regex.Test(r.Text) Then
            For Each Match In regex.Execute(r.Value)
                'The apostrophe is to keep the data formatted as text
                r.Value = "'" & Replace(r.Value, Match.Value, "")
            Next
        End If
    Next
End Sub

您还应该更改

MsgBox Err.Number & " " & Err.Description

到

If Err.Number <> 0 then MsgBox Err.Number & " " & Err.Description