>1000列50行ほどデータが詰まっており
普通は50列1000行のような表を作るのだが、ここでは質問の通りに考えよう。
>青く塗りつぶされている列の上下2例または、下2列も・・
あとの2列を問題にしているなら、塗りつぶされている列の1塊りの、始まりの左の2列、終わりの右2列も、抜き出したいという表現となるのではないか?
表現が私らとは違うね。
ーー
それにとびとびの列において、足すと>300列ほどが青く塗りつぶされています、なのか、大事なことを書いてないので、わかりづらい。
ーー
手作業かVBAでしかできないと思うが、質問者はVBAには、なじみが無いようだ。
質問者以外の他の人も、将来この質問を見ると思う(ただしよくあるケースの課題ではないと思う)ので、やってみる。
質問者は以下無視してもらっても良い。
例データ
A列ーI列
あ1 a1 b1 1 2 3 X1 y1 い1
あ2 a2 B2 1 2 3 x2 Y2 い2
あ3 a3 b3 1 2 3 X3 y3 い3
あ4 a4 b4 1 2 3 X4 y4 い4
あ5 a5 b5 1 2 3 X5 y5 い5
以下行略
1,2,3の列に縫いつぶしの色が塗りつぶされていると仮定する
すなわち、D、E、F列に青色塗りつぶしされているとする。
ーー
VBAコードは
ALTキー+F11を押すと、
出てくるVBE画面で、挿入ー標準モジュールをおこない、
そこに以下を貼り付け。
Sub test03()
k = 1
fst = "y"
rc = Worksheets("Sheet1").Cells(2, 1000).End(xlToLeft).Column
rl = Worksheets("Sheet1").Cells(1000, 1).End(xlUp).Row
'MsgBox rc
'msgbox rl
For j = 1 To rc '1000行の例
If Worksheets("Sheet1").Cells(2, j).Interior.ColorIndex = 42 Then '黄色で塗りつぶしの例
MsgBox j
If fst = "y" Then
Worksheets("sheet1").Range(Cells(1, j - 2), Cells(rl, j - 2)).Copy Sheets("Sheet2").Cells(2, k)
k = k + 1
Worksheets("sheet1").Range(Cells(1, j - 1), Cells(rl, j - 1)).Copy Sheets("Sheet2").Cells(2, k)
k = k + 1
fst = "N"
End If
lst = j
Worksheets("sheet1").Range(Cells(1, j), Cells(rl, j)).Copy Sheets("Sheet2").Cells(2, k)
k = k + 1 '該当した列をA列から順次詰めて行く
End If
Next j
Worksheets("sheet1").Range(Cells(1, lst + 1), Cells(rl, lst + 1)).Copy Sheets("Sheet2").Cells(2, k)
k = k + 1
Worksheets("sheet1").Range(Cells(1, lst + 2), Cells(rl, lst + 2)).Copy Sheets("Sheet2").Cells(2, k)
k = k + 1
End Sub
ーー
塗りつぶされたその色のColorIndex のコードは
すなわちColorIndex = 42 の「42」は
Sub test05()
MsgBox Worksheets("Sheet1").Cells(2, 4).Interior.ColorIndex
End Sub
を実行して、知ってください
結果
Sheet2に(A-G列に)
a1 b1 1 2 3 X1 y1
a2 B2 1 2 3 x2 Y2
a3 b3 1 2 3 X3 y3
a4 b4 1 2 3 X4 y4
a5 b5 1 2 3 X5 y5
元データSheet1の1,2,3のD,E,F列の両側に2列づつ、拾って加えている。
お礼
丁寧なご解答ありがとうございます。 結局関数を使って無事作業終了しました。