[Excel] ２次元データを任意間隔で間引くマクロ

目的：画像データのような2次元データの任意間隔間引き

対象データ：アクティブシートの2次元データ
・第1行にx座標（等間隔）
・第1列にy座標（等間隔）
・セル（B,2)以降に2次元データ

間引きデータ：自動作成される新規シートのセル（B,2)以降

マクロ：下記の通り

Sub Mabiki()

Dim m As Long, n As Long, i As Long, j As Long
Dim cols As Long, cole As Long, cold As Long
Dim rows As Long, rowe As Long, rowd As Long

Dim ws1 As String, ws2 As String

' シート作成
Set Sheet = ActiveSheet ' 現在アクティブなシートを取得する
ws1 = ActiveSheet.Name
ws2 = ActiveSheet.Name & "m"
Worksheets.Add
ActiveSheet.Name = ws2
Sheet.Activate 'シートをアクティブに戻す

' 2次元データ領域
cols = 2 ' 最初の列
cole = 102 ' 最終列
cold = 2 ' 間引き列数

rows = 2 ' 最初の行
rowe = 102 ' 最終行
rowd = 2 ' 間引き行数

' 間引き後の2次元データサイズ
m = (cole - cols + 1) / cold + 1
n = (rowe - rows + 1) / rowd + 1

'
Application.ScreenUpdating = False

' 第1行

For i = cols To cols + m - 1
  Sheets(ws2).Cells(i, 1) = Sheets(ws1).Cells(2 * (i - 1), 1)
Next i

' 第1列

For j = rows To rows + n - 1
  Sheets(ws2).Cells(1, j) = Sheets(ws1).Cells(1, 2 * (j - 1))
Next j

' 2次元データ：(cols, rows)～

For i = cols To cols + m - 1
  For j = rows To rows + n - 1
    Sheets(ws2).Cells(i, j) = Sheets(ws1).Cells(cold * (i - 1), rowd * (j - 1))
  Next j
Next i

Application.ScreenUpdating = True

End Sub

--------------

参考記事：

[Excel] １次元、２次元データを任意間隔で間引く方法

http://kenkitagawa.cocolog-nifty.com/blog/2009/08/excel-1bce.html