2013-03-17 8 views
0

У меня есть диапазон, который я хочу записать в файл, чередующийся между столбцами на каждой итерации. Я бы A1> B1> А2> В2 и т.д., чтобы дать пример:Ссылка на диапазон 100x2, затем печать в файл

 A | B 
1 Hello | World 
2 Whats | Up 

Теперь я бы это в текстовом файле, как:

Hello 
World 
Whats 
Up 

У меня есть следующий код, который захватит информацию от моего первого столбца, но я застрял при добавлении второго столбца на каждую итерации:

Sub mac() 
Dim fso As New FileSystemObject 
Dim stream As TextStream 
Set stream = fso.CreateTextFile("F:\Hmmmmm.txt", True) 

    Range("G2").Select 

    Do Until IsEmpty(ActiveCell) 
    stream.WriteLine ActiveCell 
    ' Here I would affectively want stream.WriteLine ActiveCell + 1 Column 
    ActiveCell.Offset(1, 0).Select 
    Loop 

End Sub 

ответ

1

Во-первых, если вы еще не сделали этого, убедитесь, что вы выбрали «Microsoft Scripting File "в разделе Инструменты в VBA редактор (Для получения дополнительной справки: How do I use FileSystemObject in VBA?).

Следующие должны работать. Примечание для чтения моих комментариев - вы можете изменить часть кода в соответствии с вашими таблицами/нуждами

Sub mac() 
    Dim ws As Worksheet 
    Dim fso As New FileSystemObject 
    Dim stream As TextStream 
    Dim DataTable As Range 
    Dim StartCell As Range 
    Dim c As Range 

    'Edit this line to save the text file to drive\path\filename of your choice 
    Const TextFileName As String = "F:\Hmmmmm.txt"  

    Set ws = ActiveSheet 
    Set fso = CreateObject("Scripting.FileSystemObject") 
    Set stream = fso.CreateTextFile(FileName:=TextFileName, Overwrite:=True) 

    'Edit this line to adjust to your spreadsheet 
    'I assume your data starts in Cell A1 
    Set StartCell = ws.Range("A1") 

    Set DataTable = StartCell.CurrentRegion 

    For Each c In DataTable.Cells 
      stream.WriteLine c.Value 
    Next c 

    Set c = Nothing 
    Set StartCell = Nothing 
    Set DataTable = Nothing 
    Set ws = Nothing 
    Set stream = Nothing 
    Set fso = Nothing 
End Sub 

 Смежные вопросы

  • Нет связанных вопросов^_^