Question

我有一个包含27列的工作表，第一行是A-Z列和总共27列的列。每列都有一个很长的受限URL列表，这些列表按列的字母排序，最后一列（第27列）用于以数字开头的URL。列的长度在300-600,000个细胞之间。

我所追求的是将每一列复制到单独文件夹下的单独文本文件（* .file），即将A列复制并保存到c：/blacklist/A/a.file，依此类推，因此我们得到c：/blacklist/B/b.file一直到c：/blacklist/NUM/num.file。

我一直在寻找解决方案，并找到了以下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

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

Answer 1

我没有测试过这个，所以没有保证。您需要将“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

更新现在应该可以使用。

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

1 个答案: