QA@IT
«回答へ戻る

回答を投稿

templateのシートをそのまま使うマクロを考えてみたり。
ヘッダとフッタは入ってないけど、追加することは難しくはないはず。
あんまり検証してないので境界条件が間違ってる可能性はあります。

result.Select
For i = 2 To m
    If data.Cells(i, 1).Value <> data.Cells(i - 1, 1).Value _
    Or data.Cells(i, 2).Value <> data.Cells(i - 1, 2).Value Then
        splitPage data, result, start, i, page
        start = i
    End If
Next
splitPage data, result, start, i, page

template.Rows("1:" & PAGE_SIZE).Copy
result.Rows(1 & ":" & (page * PAGE_SIZE - 1)).PasteSpecial Paste:=xlFormats

result.Cells(1, 1).Select

Private Sub splitPage(ByVal data As Worksheet, ByVal result As Worksheet, ByVal start As Long, ByVal i As Long, ByRef page As Long)
Dim j As Long
Dim m As Long

m = CLng((i - start) / PAGE_SIZE) - 1
For j = 0 To m
    data.Rows(start & ":" & (start + PAGE_SIZE)).Copy
    result.Cells(page * PAGE_SIZE + 1, 1).PasteSpecial Paste:=xlValues
    page = page + 1
    start = start + PAGE_SIZE
Next
If start < i Then
    data.Rows(start & ":" & (i - 1)).Copy
    result.Cells(page * PAGE_SIZE + 1, 1).PasteSpecial Paste:=xlValues
    page = page + 1
End If

End Sub

投稿者:mio

templateのシートをそのまま使うマクロを考えてみたり。
ヘッダとフッタは入ってないけど、追加することは難しくはないはず。
あんまり検証してないので境界条件が間違ってる可能性はあります。

    result.Select
    For i = 2 To m
        If data.Cells(i, 1).Value <> data.Cells(i - 1, 1).Value _
        Or data.Cells(i, 2).Value <> data.Cells(i - 1, 2).Value Then
            splitPage data, result, start, i, page
            start = i
        End If
    Next
    splitPage data, result, start, i, page

    template.Rows("1:" & PAGE_SIZE).Copy
    result.Rows(1 & ":" & (page * PAGE_SIZE - 1)).PasteSpecial Paste:=xlFormats

    result.Cells(1, 1).Select

Private Sub splitPage(ByVal data As Worksheet, ByVal result As Worksheet, ByVal start As Long, ByVal i As Long, ByRef page As Long)
    Dim j As Long
    Dim m As Long

    m = CLng((i - start) / PAGE_SIZE) - 1
    For j = 0 To m
        data.Rows(start & ":" & (start + PAGE_SIZE)).Copy
        result.Cells(page * PAGE_SIZE + 1, 1).PasteSpecial Paste:=xlValues
        page = page + 1
        start = start + PAGE_SIZE
    Next
    If start < i Then
        data.Rows(start & ":" & (i - 1)).Copy
        result.Cells(page * PAGE_SIZE + 1, 1).PasteSpecial Paste:=xlValues
        page = page + 1
    End If
End Sub


投稿者:mio