我正在使用VBA将固定文本文件导入到excel文件中。 我有一个问题,修正列(自动拟合)与数字的小数的拟合。使用VBA将固定文本文件导入到excel中
我有一个小数尽可能多5027.1202024.0000.0000.000.0000.0000.0000并想简化为5027.12,因为我的列不合适,只是分离。除了声明几个数组并修复它的宽度之外,还有另一种方法吗?该文本文件已被固定。 我还是新手,我会帮助你。由于
编辑:
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
抱歉过了这么久才回来给你,但我张贴了另一个答案。 – 2016-11-10 00:09:42
您好托马斯上面是我的更新代码加上您的代码(再次感谢!)现在我的问题是我必须省略这些额外的头只适合每一列,因为它有很多页我不知道如何循环或循环正在因为它将一遍又一遍地与文本文件中的其他页面一起使用 – Anne