Excel VBA 스크립트를 사용하여 열을 별도의 텍스트 파일에 복사합니다.

Question

27 개의 열이 포함 된 워크 시트가 있습니다. 첫 번째 행은 A-Z 및 NUM 열 총 27 열입니다. 각 열에는 제한된 URL 목록이 열의 문자로 정렬되어 있으며 마지막 열 (27 번째 열)은 숫자로 시작하는 URL에 대한 것입니다. 기둥의 길이는 300-600,000 개의 세포입니다.

내가하는 일은 각 열을 별도의 텍스트 파일 (* .file)로 복사하는 것입니다. 즉, 열 A를 복사하여 c : /blacklist/A/a.file에 저장해야합니다. on, 따라서 우리는 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 

이 스크립트 두 가지 문제가 있습니다를 별도의 폴더 아래에 텍스트 파일을 만들지 않고 대신 하나의 폴더 아래에 모든 파일을 만듭니다. 두 번째는 시도했을 때 생성 된 파일의 열 내용을 복사하지 않았다는 것입니다. 즉, 파일이 0 인 내용으로 비어 있습니다.

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 

업데이트는 지금 작동합니다.