如何通过vba将excel数据复制到多个记事本文件中

Question

我的 Excel 数据中有 4 列，这是位置明智的数据（A 列），但我想要位置明智的过滤器，只有条形码会复制，并且必须粘贴到记事本中，条形码没有限制，它应该保存在特定位置。它应该使用文件重命名列（Column-B）重命名。

我正在附加文件...

位置明智数据

输出文本文件 - 结果

A               B            C          D
LocationName FileRename Barcode Qty
Box-01  Box-01 108  8905425661077   1
Box-01  Box-01 108  8905425723577   1
Box-01  Box-01 108  8905425652105   1
Box-01  Box-01 108  8905425652969   1
Box-01  Box-01 108  8905425654659   1
Box-01  Box-01 108  8905425654222   1
Box-01  Box-01 108  8905425367504   1
Box-02  Box-02 35   8905425192250   1
Box-02  Box-02 35   8905425190454   1
Box-02  Box-02 35   8905425191475   1
Box-02  Box-02 35   8905425366668   1
Box-02  Box-02 35   8905425204106   1
Box-02  Box-02 35   8905425191819   1
Box-03  Box-03 56   8905425650231   1
Box-03  Box-03 56   8905425652235   1
Box-03  Box-03 56   8905425723133   1
Box-03  Box-03 56   8905425723898   1
Box-03  Box-03 56   8905425650231   1
Box-03  Box-03 56   8905425650156   1
Box-03  Box-03 56   8905425923793   1
Box-03  Box-03 56   8905425652013   1

谢谢和问候。 7011675525

Answer 1

• 导出前按第二列对源表进行排序

微软文档：

范围.排序方法（Excel）

公开声明

Option Explicit

Sub Demo()
    Dim rngData As Range, i As Long, oSht As Worksheet
    Dim arrData, sPath As String, FileNumber As Long
    Const KEY_COL = 2
    Set oSht = Sheets("Sheet1") ' Modify as needed
    sPath = ThisWorkbook.Path & "\"
    With oSht.Range("A1").CurrentRegion
        ' Sort data
        .Sort Key1:=.Columns(KEY_COL), order1:=xlAscending, Header:=xlYes
        Set rngData = .Resize(.Rows.Count + 1)
    End With
    ' Load data into an array
    arrData = rngData.Value
    ' Loop through data
    For i = LBound(arrData) + 1 To UBound(arrData)
        If arrData(i, 2) = arrData(i - 1, 2) Then
            ' Write to txt file
            Print #FileNumber, arrData(i, 3)
        Else
            If FileNumber > 0 Then Close FileNumber
            If Len(arrData(i, 2)) = 0 Then Exit For
            FileNumber = FreeFile
            ' Create a new file
            Open sPath & arrData(i, 2) & ".txt" For Output As FileNumber
        End If
    Next i
    MsgBox "Done"
End Sub