« [スマホ] 半角カタカナ入力方法 | トップページ | [Excel] シートタブの色を変える »

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

目的:画像データのような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] 1次元、2次元データを任意間隔で間引く方法

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

 

| |

« [スマホ] 半角カタカナ入力方法 | トップページ | [Excel] シートタブの色を変える »

パソコン・インターネット」カテゴリの記事

コメント

コメントを書く



(ウェブ上には掲載しません)




« [スマホ] 半角カタカナ入力方法 | トップページ | [Excel] シートタブの色を変える »