Question

我正在努力弄清楚如何连接我在一起找到的这两段代码。

我有一张包含c.400列的工作表，我想将每列保存到.txt文件中。问题是，我需要它使用另一个工作表上指定的名称来保存文件（所有这些都按列的顺序）。

我认为相关的两个VBA如下：

Sub VBA_write_to_a_text_file_from_Excel_Range()
    Dim iCntr as Lonng
    Dim strFile_Path As String
    strFile_Path = "C:\temp\test.txt"

    Open strFile_Path For Output As #1
For iCntr = 1 To 10
    Write #1, Range("A" & iCntr)
Next iCntr
    Close #1
End Sub 

Sub CreateFolder()
Dim MyFile As String
MyFile = Sheets("Request form").Range("F9").Text
ActiveWorkbook.SaveAs Filename:=sDir & "\" & MyFile
End Sub

非常感谢任何帮助。

谢谢，

克里斯

Answer 1

以下是将列保存到文本文件的两种方法：

Option Explicit

Private fso As Variant

Sub saveColsToText()
    Const START_COL As Long = 2
    Const START_ROW As Long = 2
    Const FNAME_ROW As Long = 2
    Const F_PATH As String = "C:\Temp\"

    Dim ws1 As Worksheet, ws2 As Worksheet, thisCol As Range
    Dim lr As Long, lc As Long, i As Long, colStr As String

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")

    With ws1
        lc = .Cells(1, .Columns.Count).End(xlToLeft).Column
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row

        For i = START_COL To lc
            Set thisCol = .Range(.Cells(1, i), .Cells(lr, i))
            colStr = Join(Application.Transpose(thisCol.Value2), vbCrLf)
            saveColToFile1 F_PATH, ws2.Cells(FNAME_ROW, i).Value2 & ".txt", colStr
        Next
    End With
End Sub

Sub saveColToFile1(ByVal fPath As String, ByVal fName As String, ByVal colText As String)
    Dim fileID As Variant

    If Len(Dir(fPath)) = 0 Then MkDir fPath
    Set fileID = fso.CreateTextFile(fPath & fName, True)
    fileID.Write colText
    fileID.Close
    Set fileID = Nothing
End Sub

Sub saveColToFile2(ByVal fPath As String, ByVal fName As String, ByVal colText As String)
    Open fPath & fName For Output As #1
    Write #1, colText
    Close #1
End Sub

'------------------------------------------------------------------------------------------

使用文件名循环将列保存到文本循环

1 个答案: