excel VBA -平面文本导入更改

xxb16uws 于 2023-01-21 发布在其他

关注(0)|答案(2)|浏览(124)

我们有一个使命关键型电子表格，它从设计程序中导入大量平面文本，然后将其导入到电子表格中。
我们最近更新了设计软件，我们每年更新一次，我在这里工作12年了。今年，他们对一个文件做了修改，把一列文本的标题放在了不同的地方。现在，我们的程序不能正确导入它。它是PART列......
旧文本文件：

新建文本文件...

如你所见，他们把零件移到了左下角。
不是VBAMaven，我很难找到我需要修改代码的确切位置来正确地引入它。
这是VBA代码的一部分，我认为在这里进行了选择，但没有在代码中指定PART ......也许它是数组的一部分？该文件名为CZE_DET. OUT。

Sub IMPORT_CZEOUT()
    Dim aryJobs() As String
    Dim strComb As String
    Dim strDir As String
    Dim i As Integer
    Dim j As Integer
    Dim k As Integer

    Sheets("CEE ORDER").Visible = True
    Sheets("CZE_DET").Visible = True
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Sheets("CEE ORDER").Select
    For i = 1 To colAllBuildings.Count
        strDir = Dir$(colAllBuildings.Item(i) & "\CZE_DET.OUT")
        If strDir <> "" Then
            Workbooks.OpenText Filename:=colAllBuildings.Item(i) & "\CZE_DET.OUT", Origin:=xlWindows, _
                               StartRow:=7, DataType:=xlFixedWidth, _
                               FieldInfo:=Array(Array(0, 9), Array(5, 1), Array(9, 9), Array(10, 1), _
                               Array(13, 9), Array(14, 1), Array(15, 9), Array(16, 1), Array(18, 1), _
                               Array(28, 9), Array(35, 9), Array(47, 9), Array(54, 1), Array(57, 1), _
                               Array(62, 1), Array(67, 1), Array(72, 1))
            Range("A1:L" & CStr(Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row)).Select
            Selection.Copy
            Windows(strShipperName).Activate ' This line does not work, for NO reason!
'            Windows(1).ActivatePrevious
            Sheets("CZE_DET").Select
            Range("A1").Select
            If Range("A1").Value <> "" Then
                ActiveSheet.Range("A65536").End(xlUp).Select
                ActiveCell.Offset(1, 0).Select
            End If
            Selection.PasteSpecial Paste:=xlValues
            Selection.Sort Key1:=Range("A12"), Order1:=xlAscending, Orientation:=xlTopToBottom
            Windows("CZE_DET.OUT").Activate
            ActiveWindow.Close
        End If
    Next

我想发布电子表格，但它通过网络共享的XLA文件附加VBA。XLA文件是受保护的，我似乎不能重命名它，并删除密码发送链接。
我在这里发布了整个子例程，因为我只发布了我认为问题会出现的地方：https://pinnaclestructures365-my.sharepoint.com/:f:/g/personal/bwolters_pinnaclestructures_com/EpGrxtGx4_BCgL4nl3QDZxcBalaRSL52pI0S8UNX0n6kOg?e=0oyh2k
有什么建议吗？

excel

来源：https://stackoverflow.com/questions/75163930/vba-flat-text-import-changes

2条答案

按热度按时间

4bbkushb1#

下面是一个重新设计的例子，说明如何使你的引用更加明确。

Sub IMPORT_CZEOUT()
    Dim aryJobs() As String
    Dim strComb As String
    Dim strDir As String
    Dim i As Integer, cDest As Range
    Dim j As Integer, fName As String, rngData As Range, lRow As Long
    Dim k As Integer, wb As Workbook, wbSrc As Workbook, wsSrc As Worksheet

    Set wb = Workbooks(strShipperName) 'The wb where data is to be collected
                                       'Include the file extension!
    wb.Sheets("CEE ORDER").Visible = True
    wb.Sheets("CZE_DET").Visible = True
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    For i = 1 To colAllBuildings.Count
        fName = colAllBuildings.Item(i) & "\CZE_DET.OUT"
        If Len(Dir(fName)) > 0 Then
            Workbooks.OpenText Filename:=fName, Origin:=xlWindows, _
                               StartRow:=7, DataType:=xlFixedWidth, _
                               FieldInfo:=Array(Array(0, 9), Array(5, 1), Array(9, 9), Array(10, 1), _
                               Array(13, 9), Array(14, 1), Array(15, 9), Array(16, 1), Array(18, 1), _
                               Array(28, 9), Array(35, 9), Array(47, 9), Array(54, 1), Array(57, 1), _
                               Array(62, 1), Array(67, 1), Array(72, 1))
            Set wbSrc = ActiveWorkbook      'source data workbook
            Set wsSrc = wbSrc.Worksheets(1) 'source data sheet
            lRow = wsSrc.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            Set rngData = wsSrc.Range("A1:L" & lRow) 'all source data
            With wb.Worksheets("CZE_DET") 'EDIT
                Set cDest = .Cells(.Rows.Count, "A").End(xlUp)
            End With
            If Len(cDest.Value) > 0 Then Set cDest = cDest.Offset(1)
            cDest.Resize(rngData.Rows.Count, rngData.Columns.Count).Value = rngData.Value
            'not sure about this line....
            Selection.Sort Key1:=Range("A12"), Order1:=xlAscending, Orientation:=xlTopToBottom
            wbSrc.Close savechanges:=False 'close the source file
        End If
    Next
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

EDIT -正如注解中指出的，其中一个字段的长度增加了1个字符，因此需要更新FieldInfo参数：

Workbooks.OpenText Filename:=fName, Origin:=xlWindows, _
                           StartRow:=7, DataType:=xlFixedWidth, _
                           FieldInfo:=Array(Array(0, 9), Array(5, 1), Array(9, 9), Array(10, 1), _
                           Array(13, 9), Array(14, 1), Array(15, 9), Array(16, 1), Array(18, 1), _
                           Array(28, 9), Array(35, 9), Array(47, 9), Array(55, 1), Array(58, 1), _
                           Array(63, 1), Array(68, 1), Array(73, 1))

赞(0）回复(0）举报 2023-01-21

gjmwrych2#

open语句可以简化，因为跳过的字段（type=9）是空白，并且值在导入时被修剪。

Workbooks.OpenText Filename:=s, Origin:=xlWindows, _
          StartRow:=7, DataType:=xlFixedWidth, _
          FieldInfo:=Array(Array(0, 9), Array(4, 1), Array(18, 1), Array(27, 1), _
                           Array(35, 1), Array(54, 1), Array(58, 1),  _ 
                           Array(63, 1), Array(68, 1), Array(73, 1))

使用此文本文件进行测试

line 1
line 2
line 3
line 4
line 5
line 6
ish description   part     punch   comment            qnt feet inch 16th mark
--- ------------- -------- ------- ------------------ --- ---- ---- ---- ------
xxx  8.0x3.5 c 12 8x35c12  psu-psu see drawing ec-1    28  16    8    3  ec-1
xxx  8.0x3.5 c 12 8x35c12  psu-psu see drawing ec-1    28  16    8    3  ec-1
xxx  8.0x3.5 c 12 8x35c12  psu-psu see drawing ec-1    28  16    8    3  ec-1
a-z a-----------z a----- z a-----z a----------------z a-z a--z a--z a--z a----z

赞(0）回复(0）举报 2023-01-21

我来回答

excel VBA -平面文本导入更改

2条答案

相关问题

热门标签

最新问答