April 6, 2014

Excelで選択範囲のデータを間引く

Excelでデータを間引くマクロは色々なサイトで紹介されていますが、ここでは、選択したセル範囲内だけを処理するマクロを紹介します。
 
なお、選択範囲を事前に調整するために以下のサブルーチンを使用しますので、使用される場合は以下のコードも合わせて使ってください。
found, known and done.: Excelの選択範囲をデータのある範囲に縮小する
http://foundknownanddone.blogspot.jp/2014/04/excel-shrink-selection.html#more

使用方法

セル範囲、行、列、シート全体を選択します。
マクロを実行して、何行ごとに間引きたいのか指定します。
(なお、行や列を選択した場合、データの前後の空白セル部分は処理されません。)

コード

Sub combOutRow()
    Dim targetRange As Range
    Dim outputData() As Variant
    Dim spacing As Integer
    Dim maxRowCount As Long, minRowCount As Long
    Dim rowIndex As Long, columnIndex As Long

    Call shrinkSelectionRow
    Set targetRange = Selection
    
    spacing = CInt(Application.InputBox("Spacing = ", "combOutRow", 1, , , , , 1))
    If spacing < 1 Then Exit Sub
    
    rowIndex = WorksheetFunction.Floor((targetRange.Rows.Count - 1) / spacing, 1) + 1
    columnIndex = targetRange.Columns.Count
    ReDim outputData(1 To rowIndex, 1 To columnIndex)
    
    For i = 1 To targetRange.Rows.Count
        If (i - 1) Mod spacing = 0 Then
        For j = 1 To targetRange.Columns.Count
            outputData(1 + (i - 1) / spacing, j) = targetRange.Cells(i, j)
        Next
        End If
    Next

    With targetRange
        .ClearContents
        Range(.Rows(1), .Rows(rowIndex)) = outputData
        Range(.Rows(1), .Rows(rowIndex)).Select
    End With
End Sub

Sub combOutColumn()
    Dim targetRange As Range
    Dim outputData() As Variant
    Dim spacing As Integer
    Dim maxColumnCount As Long, minColumnCount As Long
    Dim rowIndex As Long, columnIndex As Long
    
    Call shrinkSelectionColumn
    Set targetRange = Selection
    
    spacing = CInt(Application.InputBox("Spacing = ", "combOutColumn", 1, , , , , 1))
    If spacing < 1 Then Exit Sub
    
    rowIndex = targetRange.Rows.Count
    columnIndex = WorksheetFunction.Floor((targetRange.Columns.Count - 1) / spacing, 1) + 1
    ReDim outputData(1 To rowIndex, 1 To columnIndex)
    
    For i = 1 To targetRange.Columns.Count
        If (i - 1) Mod spacing = 0 Then
        For j = 1 To targetRange.Rows.Count
            outputData(j, 1 + (i - 1) / spacing) = targetRange.Cells(j, i)
        Next
        End If
    Next

    With targetRange
        .ClearContents
        Range(.Columns(1), .Columns(columnIndex)) = outputData
        Range(.Columns(1), .Columns(columnIndex)).Select
    End With
End Sub

No comments :

Post a Comment