2015-08-18 88 views
0

我在努力弄清楚如何连接这两段代码,我找到了一起。将列保存为文本循环带文件名循环

我有一张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 

任何帮助将不胜感激。

谢谢

克里斯

+0

嘿@CDH,欢迎SO!你更具体地经历了什么错误?什么是'catch'? – Klaster

+0

不清楚?像这样说... 1.你需要什么...... 2.你的代码是什么...... 3.代码的问题是什么......!这样发布。 –

+0

嗨@Klaster,我有一张c.400列的表格,我想将每列保存为一个.txt文件。问题在于我需要使用另一个工作表上指定的名称来保存文件(全部按照列的顺序)。它需要两个循环 - 一个保存列和一个寻找名称。我认为。道歉,我对VBA很陌生。 – CDH

回答

0

这里有2种方式,以节省列到文本文件:

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 

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