Excel VBA脚本将列复制到不同目录下的单独文本文件中

我有一个包含27列的工作表，第一行是AZ列和NUM总共27列。 每列都有一个很长的受限制的url列表，按照列的字母sorting，最后（第27）列是以数字开头的url。 专栏的长度在300-600千个细胞之间。

我所追求的就是将每一列拷贝到单独的文件夹下的一个单独的文本文件（* .file），即A列将被复制并保存到c：/blacklist/A/a.file等等，因此我们获取c：/blacklist/B/b.file一直到c：/blacklist/NUM/num.file。

我一直在寻找一个解决scheme，并find以下VBA脚本，这是非常接近我后，在http://www.ozgrid.com/forum/showthread.php?t=142181

Option Explicit Public Sub Columns_2_TextFile() Const My_Path = "C:\TEXTFILES\" Dim iCol As Integer Dim lRow As Long Dim File_Num As Long On Error Resume Next If Trim(Dir(My_Path, vbDirectory)) = "" Then MkDir My_Path Else Kill My_Path & "*.txt" End If On Error Goto 0 File_Num = FreeFile With ActiveSheet For iCol = 2 To 256 Open My_Path & Trim(.Cells(2, iCol).Value) & ".txt" For Output As #File_Num For lRow = 3 To .Cells(Rows.Count).End(xlUp).Row Print #File_Num, .Cells(lRow, iCol).Value Next Close #File_Num Next End With MsgBox "All files created and saved to : " & My_Path End Sub 

这个脚本有两个问题：第一个是它不创build单独的文件夹下的文本文件，而是创build一个文件夹下的所有文件。 第二个是，当我尝试它时，它没有复制创build的文件中的列内容，换句话说，文件是空的零内容。

Answer 1

我没有testing过，所以没有保证。 您需要将“Sheet1”更改为您的工作表的名称。

 Public Sub Main() Dim Path As String: Path = "C:\blacklist\" Dim Column As Integer Dim Row As Long Dim Name As String Dim File As Long Dim Sheet As Worksheet: Set Sheet = ThisWorkbook.Worksheets("Sheet1") For Column = 1 To 27 Name = Sheet.Cells(1,Column).Value2 On Error Resume Next If Trim(Dir(Path & Name & "\", vbDirectory)) = "" Then MkDir Path & Name & "\" Else Kill Path & Name & "\*.file" End If On Error Goto 0 File = FreeFile Open Path & Name & "\" & Name & ".file" For Output As #File For Row = 2 To Sheet.Cells(Sheet.Rows.Count, Column).End(xlUp).Row ' fixed Print #File, Sheet.Cells(Row, Column).Value2 Next Row Close #File Next Column End Sub 

更新它现在应该工作。