L oop диапазон и пропуск строк в Excel Excel - PullRequest
0 голосов
/ 18 марта 2020

У меня есть лист Excel, который принимает данные из другого файла Excel. Этот файл Excel содержит структурированные данные, которые необходимо разделить на отдельные листы. У меня уже есть следующий код для копирования и форматирования этих данных в определенном диапазоне, но мне нужно l oop этот процесс для всей рабочей таблицы до тех пор, пока не останется больше данных.

Диапазон, который я сейчас установил, равен A2: P20 следующий диапазон на 4 строки ниже, и это будет A25: P43 .

    Option Explicit

    Public Sub CopySheetToClosedWorkbook()
    Dim fileName
    Dim closedBook As Workbook
    Dim currentSheet As Worksheet

    fileName = Application.GetOpenFilename("Excel Files (*.xls*),*xls*")

    If fileName <> False Then
        Application.ScreenUpdating = False

        Set currentSheet = Application.ActiveSheet
        Set closedBook = Workbooks.Open(fileName)

        closedBook.Sheets(1).Range("A2:P20").Copy
        ThisWorkbook.Worksheets("input").Range("A2").PasteSpecial xlPasteValues

        closedBook.Application.CutCopyMode = False
        closedBook.Close (True)

        Application.ScreenUpdating = True

        CopySheetAndRenameByCell2

    End If
End Sub

Ответы [ 2 ]

1 голос
/ 18 марта 2020

Вы можете сделать что-нибудь на основе кода ниже. Я установил последнюю строку как 1000, вам нужно будет извлечь это из ваших данных.

Sub SplitRangeTest()

Dim lLastRow As Long
Dim lRow As Long
Dim lRangeSize As Long
Dim lSpacerSize As Long

lRangeSize = 19
lRow = 2
lSpacerSize = 4
lLastRow = 1000   ' Get the last populated row in the column of choice here

Do Until lRow > lLastRow

    Debug.Print Range("A" & lRow).Resize(lRangeSize, 16).Address

    lRow = lRow + lRangeSize + lSpacerSize

Loop

End Sub
0 голосов
/ 18 марта 2020

Попробуйте:

Public Sub CopySheetToClosedWorkbook()
    Dim fileName As String
    Dim closedBook As Workbook
    Dim currentSheet As Worksheet

    fileName = Application.GetOpenFilename("Excel Files (*.xls*),*xls*")

    If fileName <> False Then
        start_row = 2
        rows_to_copy = 19
        row_step = 23

        Set currentSheet = Application.ActiveSheet
        Set closedBook = Workbooks.Open(fileName)

        last_row = Sheets(1).Cells(Sheets(1).Rows.Count, "A").End(xlUp).Row

        Application.ScreenUpdating = False
        For y = start_row To last_row Step row_step
            ThisWorkbook.Worksheets("input").Rows(y).Resize(rows_to_copy, 16).Value = closedBook.Sheets(1).Rows(y).Resize(rows_to_copy, 16).Value
        Next
        Application.ScreenUpdating = True
    End If
End Sub

стоит упомянуть, что вы установили currentSheet, но на самом деле не используете его. Кроме того, вы не должны использовать ThisWorkbook таким образом. Возможно, вам следует использовать currentSheet вместо этого (или, по крайней мере, его родитель).

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