Макрос Excel: для цикла файла в файл - PullRequest
2 голосов
/ 28 октября 2011

Я не знаю VBA, но мне нужно написать макрос для оптимизации моей работы.Я ищу свой код для циклического перемещения по файлам и копирования / вставки одного и того же столбца из каждого файла в книгу Excel (столбец за столбцом).Это то, что у меня есть (обратите внимание, что я поставил «i» в имени файла):

Sub NewMacro()

For i = 0 To 99

    Workbooks.OpenText Filename:= _
        "C:\User\Folder\file_up000i.txt", _
        Origin:=932, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True
    Range("A3").Select
    Selection.Copy
    With ActiveWindow
        .Top = 6.25
        .Left = 53.5
    End With
    Windows("Book1").Activate
    With ActiveWindow
        .Top = 40.75
        .Left = 13
    End With
    Range("B1").Select
    ActiveSheet.Paste
    Windows("file_up000i.txt").Activate
    Range("C26").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Book1").Activate
    Range("B2").Select
    ActiveSheet.Paste
    Windows("file_up000i.txt").Activate
    With ActiveWindow
        .Top = 4
        .Left = -75.5
    End With
    ActiveWindow.Close

    Next i

End Sub

Ясно, что это не работает, но я понятия не имею, как еще это сделать.Большое спасибо за вашу помощь!

1 Ответ

3 голосов
/ 29 октября 2011

Предположим, что ваши файлы названы file_up0000.txt, file_up0001.txt ... file_up0099.txt Вот рефакторинг вашего макроса

Sub NewMacro()
    Dim i As Long
    Dim shTxt As Worksheet
    Dim shDest As Worksheet
    Dim TxtName As String

    Set shDest = ActiveSheet
    For i = 0 To 99
        TxtName = "file_up" & Format(i, "0000")
        Workbooks.OpenText Filename:= _
            "C:\User\Folder\" & TxtName & ".txt", _
            Origin:=932, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
            xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
            Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
            TrailingMinusNumbers:=True

        Set shTxt = Workbooks(TxtName & ".txt").Worksheets(TxtName)

        shTxt.[A3].Copy shDest.[B1]
        shTxt.Range(shTxt.[C26], shTxt.Range("C26").End(xlDown)).Copy shDest.[B2]
        shTxt.Parent.Close False
    Next i

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...