1

我有一个包含 27 列的工作表，第一行是列标题，它们是 AZ 和 NUM，共 27 列。每列都有一个非常长的受限 url 列表，按列的字母排序，最后（第 27 列）用于以数字开头的 url。列的长度在 300-60 万个单元格之间。

我所追求的是将每一列复制到单独文件夹下的单独文本文件（*.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

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

4

1 回答 1

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

更新它现在应该可以工作了。

于 2013-04-08T21:20:58.447 回答