0

我创建了一个带有宏的 Excel 工作簿，该宏旨在将工作表中的所有数据导出到固定宽度的 .txt 文件。

除了一件事，我的一切工作都很好。我的 XWGHT 字段在字段值之后出现空格，而它们需要在之前。下面我附上了我正在查看的内容。上面的窗口是一个包含真实示例数据的文件，下面是我的测试数据写入 .txt 文件。

不确定附加信息是否有帮助，但我正在导出为文本的工作表的所有字段都格式化为“文本”

文件比较

我的代码：

'Export
Sub Export()

    'Clear out Export Worksheet
    Worksheets("Export").Cells.ClearContents

    ' Fill "Export" worksheet with the desired columns from "FeedSamples" in the order
    ' listed in ImpfileFDF.pdf found in \\agfiles\public\Formflow

    ' Use rowCnt to designate the range to copy to "Export" worksheet
    Dim rowCnt As Long
    rowCnt = Worksheets("FeedSamples").range("A1").CurrentRegion.Rows.Count

    ' LABELRENO = XLABLER
    Worksheets("Export").range("A1:A" & rowCnt).value = Worksheets("FeedSamples").range("A1:A" & rowCnt).value
    ' XRPTNO = REPTNO
    Worksheets("Export").range("B1:B" & rowCnt).value = Worksheets("FeedSamples").range("B1:B" & rowCnt).value
    ' XPROD = B
    Worksheets("Export").range("C1:C" & rowCnt).value = Worksheets("FeedSamples").range("C1:C" & rowCnt).value
    ' XCLS1 = PRODNO1
    Worksheets("Export").range("D1:D" & rowCnt).value = Worksheets("FeedSamples").range("E1:E" & rowCnt).value
    ' XCLS2 = PRODNO2
    Worksheets("Export").range("E1:E" & rowCnt).value = Worksheets("FeedSamples").range("F1:F" & rowCnt).value
    ' XCLS3 = PRODNO3
    Worksheets("Export").range("F1:F" & rowCnt).value = Worksheets("FeedSamples").range("G1:G" & rowCnt).value
    ' DESC1 = XDSC1
    Worksheets("Export").range("G1:G" & rowCnt).value = Worksheets("FeedSamples").range("H1:H" & rowCnt).value
    ' DESC2 = XDSC2
    Worksheets("Export").range("H1:H" & rowCnt).value = Worksheets("FeedSamples").range("I1:I" & rowCnt).value
    ' DESC3 = XDSC3
    Worksheets("Export").range("I1:I" & rowCnt).value = Worksheets("FeedSamples").range("J1:J" & rowCnt).value
    ' DESC4 = XDSC4
Worksheets("Export").range("J1:J" & rowCnt).value = Worksheets("FeedSamples").range("K1:K" & rowCnt).value
    ' POSSNO = XPOSSR
    Worksheets("Export").range("K1:K" & rowCnt).value = Worksheets("FeedSamples").range("L1:L" & rowCnt).value
    ' DATEINSP = XDATE
    Worksheets("Export").range("L1:L" & rowCnt).value = Worksheets("FeedSamples").range("M1:M" & rowCnt).value
    ' SAMRECNO = XRCPT#
    Worksheets("Export").range("M1:M" & rowCnt).value = Worksheets("FeedSamples").range("N1:N" & rowCnt).value
    ' NOBAGS = XNOBAG
    Worksheets("Export").range("N1:N" & rowCnt).value =     Worksheets("FeedSamples").range("O1:O" & rowCnt).value
    ' NOGUAR = XNOGAR
    Worksheets("Export").range("O1:O" & rowCnt).value = Worksheets("FeedSamples").range("P1:P" & rowCnt).value
    ' ANALYSIS49 = X49
    Worksheets("Export").range("P1:P" & rowCnt).value = Worksheets("FeedSamples").range("S1:S" & rowCnt).value
    ' ANALYSIS50 = X50
    Worksheets("Export").range("Q1:Q" & rowCnt).value = Worksheets("FeedSamples").range("T1:T" & rowCnt).value
    ' BAGTAG = XMRKCD
    Worksheets("Export").range("R1:R" & rowCnt).value = Worksheets("FeedSamples").range("U1:U" & rowCnt).value
    ' ONHAND = XONHND
    Worksheets("Export").range("S1:S" & rowCnt).value = Worksheets("FeedSamples").range("V1:V" & rowCnt).value
    ' WTLBS = XWGHT
    Worksheets("Export").range("T1:T" & rowCnt).value = Worksheets("FeedSamples").range("W1:W" & rowCnt).value
    ' REMARKS = XCOMNT
    Worksheets("Export").range("U1:U" & rowCnt).value = Worksheets("FeedSamples").range("AA1:AA" & rowCnt).value
    ' MED = XMED
    Worksheets("Export").range("V1:V" & rowCnt).value = Worksheets("FeedSamples").range("AK1:AK" & rowCnt).value
    ' NONMED = XNOMED
    Worksheets("Export").range("W1:W" & rowCnt).value = Worksheets("FeedSamples").range("AL1:AL" & rowCnt).value
    ' GUARANL = XGANAL
    Worksheets("Export").range("X1:X" & rowCnt).value = Worksheets("FeedSamples").range("BP1:BP" & rowCnt).value
    ' GUARANMENT = XGMET
    Worksheets("Export").range("Y1:Y" & rowCnt).value = Worksheets("FeedSamples").range("BQ1:BQ" & rowCnt).value
    ' FLAGSAM = XFLAG
    Worksheets("Export").range("Z1:Z" & rowCnt).value = Worksheets("FeedSamples").range("Q1:Q" & rowCnt).value
    ' SAMDEF = XTYPE
    Worksheets("Export").range("AA1:AA" & rowCnt).value = Worksheets("FeedSamples").range("R1:R" & rowCnt).value
    ' TAKENOTHER = XTAKEN
    Worksheets("Export").range("AB1:AB" & rowCnt).value = Worksheets("FeedSamples").range("AS1:AS" & rowCnt).value
    ' METH1 = XMETHD
    Worksheets("Export").range("AC1:AC" & rowCnt).value = Worksheets("FeedSamples").range("AT1:AT" & rowCnt).value

    ' Need to format date fields from MM/DD/YYYY to MMDDYYYY for insertion to .txt file
    Dim n As Integer
    For n = 2 To rowCnt
        Worksheets("Export").range("L" & n).value = Format(Worksheets("Export").range("L" & n).value, "mmddyyyy")
    Next

    Dim txtFile As String
    txtFile = "\\filePATH\Personal Project Notes\IMPFILE.txt"
    'Specify the widths of fields
    'The number of columns is the number specified in the line below +1
    Dim s(29) As Integer
    s(0) = 6
    s(1) = 6
    s(2) = 4
    s(3) = 1
    s(4) = 2
    s(5) = 1
    s(6) = 1
    s(7) = 1
    s(8) = 1
    s(9) = 1
    s(10) = 6
    s(11) = 8
    s(12) = 6
    s(13) = 2
    s(14) = 2
    s(15) = 1
    s(16) = 1
    s(17) = 40
    s(18) = 12
    s(19) = 6
    s(20) = 79
    s(21) = 1
    s(22) = 1
    s(23) = 2
    s(24) = 2
    s(25) = 1
    s(26) = 1
    s(27) = 17
    s(28) = 18

    'Write data to file
    CreateFixedWidthFile txtFile, Worksheets("Export"), s

End Sub

Sub CreateFixedWidthFile(strFile As String, ws As Worksheet, s() As Integer)
    Dim i As Long, j As Long
    Dim strLine As String, strCell As String

    'Get Freefile
    Dim fNum As Long
    fNum = FreeFile

    ' Open Textfile
    Open strFile For Output As fNum

    ' Loop through all rows. i = 1 to include Headers in txt file, 2 to ignore Header row
    For i = 2 To ws.range("a65536").End(xlUp).row
        ' New Line
        strLine = ""
        ' Loop through each cell (field) in row
        For j = 0 To UBound(s)
            ' Write only to the length of the field
            strCell = Left$(ws.Cells(i, j + 1).value, s(j))
            ' Add spaces to field value if value less than field length maximum
        strLine = strLine & strCell & String$(s(j) - Len(strCell), Chr$(32))
        Next j
        ' Write record to file
        Print #fNum, strLine
    Next i
    ' Close file
    Close #fNum

End Sub

编辑：

成功！

非常感谢蒂姆！对不起，我昨天搞砸了，没有注意到您在代码中放置的评论。

4

2 回答 2

1

编辑（更仔细阅读问题后）

For j = 0 To UBound(s)
    tmp = ws.Cells(i, j + 1).value
    pad = String(s(j),Chr(32))   
    If j = 10 Then 'change number to required column
        strLine = strLine & Right(pad & tmp, s(j))  'pad on left
    else
        strLine = strLine & Left(tmp & pad, s(j))  'pad on right
    end if   
Next j
于 2013-06-12T21:59:29.943 回答
0

从快照中，我的印象是这是一个对齐问题。电子表格可能对不同的单元格有不同的对齐方式，您编写的代码无法解决此问题。在每行写完之后试试这个： Worksheets("Export").range("" & rowCnt).Horizo​​ntalAlignment = xlCenter

于 2013-06-12T21:29:06.187 回答