【VBA】セル範囲選択の繰り返し

質問

添付画像の表が複数あります。画像の赤色セルように、１行の間隔でセル範囲を選択し、表の数だけ繰り返して、すべての範囲に対して下記のような処理を行いたいです。表の選択行数が増えた場合をや表の数が増えた場合を考慮した記述にしたいと思っております。
また、行数や表数が増えた場合、どの箇所を修正するのかを併せて教えていただけると助かります。
お手数お掛けいたしますが、よろしくお願い致します。

================================================================
Sub セルの範囲選択()
Set Target = Intersect(Target, Rang("C9:CH9,C11:CH11,C13:CH13,C15:CH15,C17:CH17,C19:CH19,C21:CH21,C23:CH23,C25:CH25,C27:CH27,C37:CH37,C39:CH39,C41:CH41～繰り返す"))
　 If 　処理１
　 End If
End Sub
============================================================

回答No.4

tom04 · ベストアンサー

何度もごめんなさい。
投稿後、もう一度お礼欄のコードを見直してみました。
結局↓のような感じをご希望だったのでしょうか？

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Long, k As Long, myRange As Range
Set myRange = Range("C9").Resize(, 84)
For i = 9 To Cells(Rows.Count, "A").End(xlUp).Row Step 28
For k = i To i + 18 Step 2
Set myRange = Union(myRange, Cells(k, "C").Resize(, 84))
Next k
Next i
If Intersect(Target, myRange) Is Nothing Then Exit Sub
Cancel = True
With Target
If .Value = 1 Then
.ClearContents
.Interior.Pattern = xlPatternNone
Else
.Value = 1
.Font.ColorIndex = 3
.Interior.ColorIndex = 3
End If
End With
End Sub

※　もし上記方法で良い場合は、
＞Set Target = Intersect(Target, Range(myRange))
＞If Target Is Nothing Then
＞Exit Sub
＞Else
の部分を
＞If Intersect(Target, myRange) Is Nothing Then Exit Sub
に変更しただけです。m(_ _)m

お礼

tom04様
私の質問に何度もご回答くださり、本当にありがとうございました。
私の説明が足りず、ご面倒お掛けいたし申し訳ございません。
ご教示いただいたもので、希望通りの結果を得ることができました。「If Intersect(Target, myRange) Is Nothing Then Exit Sub」の箇所がエラーの原因だったのですね。VBAは本当に奥が深いというか、難しいですね。
完璧なプログラムを教えていただき感謝いたしております。

回答No.3

tom04

ん～～～
やりたいコトがなかなか見えてこないのですが・・・
お示しのコードを拝見すると、ダブルクリックするたびに、各行に色付けをするような感じで
反応が若干遅くなるのでは？

前回の１行おきの行の色付けのマクロとダブルクリックのイベントプロシージャーを
別々にしてはダメなのですか？

とりあえず、１行おきのセルを一気に選択し、色付けするのではなく、
↓のコードで一旦マクロを実行しておきます。

Sub Sample3()
Dim i As Long, k As Long, lastRow As Long
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
If lastRow > 8 Then
Range(Cells(9, "C"), Cells(lastRow, "CH")).Interior.ColorIndex = xlNone
End If
For i = 9 To Cells(Rows.Count, "A").End(xlUp).Row Step 28
For k = i To i + 18 Step 2
Cells(k, "C").Resize(, 84).Interior.ColorIndex = 3
Next k
Next i
End Sub

ここまでは前回の「セル選択」　→　選択セルに色付け　と同じ結果となります。

次にシートモジュールに↓のコードをコピー＆ペーストし、範囲内をダブルクリック！

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
If .Column >= 3 And .Column <= 86 Then
Cancel = True
If .Interior.ColorIndex = 3 Then
If .Value = 1 Then
.ClearContents
.Font.ColorIndex = xlAutomatic
.Interior.ColorIndex = xlNone
Else
.Value = 1
.Font.ColorIndex = 3
.Interior.ColorIndex = 3
End If
'↓不要かも・・・
ElseIf .Offset(, -1).Interior.ColorIndex = 3 Or .Offset(, 1).Interior.ColorIndex = 3 Then
.Font.ColorIndex = 3
.Interior.ColorIndex = 3
'↑ここまで不要？
End If
End If
End With
End Sub

※　実際どんなことをやりたいのか説明があると
もっと的確な方法を提案できると思います。m(_ _)m

回答No.2

tom04

No.1です。
補足を読みました。

要は行合わせだけのです。
実状に合わせてください。
尚、A列が2行ずつ結合してあり、データが必要量だけ入っているとします。

Sub Sample2()
Dim i As Long, k As Long, myRange As Range
Set myRange = Range("C9").Resize(, 84)
For i = 9 To Cells(Rows.Count, "A").End(xlUp).Row Step 28 '9行目～A列最終行まで28行おき
For k = i To i + 18 Step 2 'i 行目　～ i　行プラス18行目まで1行おき
Set myRange = Union(myRange, Cells(k, "C").Resize(, 84))
Next k
Next i
myRange.Select
End Sub

こんなんではどうでしょうか？m（_ _）m

お礼

すみません。補足に記載したプログラムに誤りがありましたので訂正させていただきます。
正しくは、以下になります。大変失礼いたしました。
※Set Target = Intersect(Target, Range(myRange))以降は同じです。

お手数お掛けいたしますが、アドバイスいただければと思います。よろしくお願い致します。
'=================================================
Sub Sample2()
Dim i As Long, k As Long, myRange As Range
Set myRange = Range("C9").Resize(, 84)
For i = 9 To Cells(Rows.Count, "A").End(xlUp).Row Step 28 '9行目～A列最終行まで28行おき
For k = i To i + 18 Step 2 'i 行目　～ i　行プラス18行目まで1行おき
Set myRange = Union(myRange, Cells(k, "C").Resize(, 84))
Next k
Next i
Set Target = Intersect(Target, Range(myRange))

If Target Is Nothing Then
Exit Sub
Else
Cancel = True
With Target
If .Value = 1 Then
.ClearContents
.Interior.Pattern = xlPatternNone
Else
.Value = 1
.Font.ColorIndex = 3
.Interior.ColorIndex = 3
End If
End With
End If
End Sub

補足

ご回答ありがとうございます。
おかげ様で希望の結果を得られました。
頂いた結果を使い、「Set Target = Intersect
」にて下記のようなクリックイベントの設定をしたいと思っているのですが、なぜかうまく動きません。
何度もお手数お掛けして申し訳ございませんが、アドバイスをいただければと思います。
お手数お掛けいたしますが、よろしくお願い致します。

'=================================================

Private Sub 範囲指定_10件DoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim i As Long, myRange As Range

Set myRange = Range("C9").Resize(, 84) '←開始行を指定（"C9：CH84）

For i = 9 To Cells(Rows.Count, "B").End(xlUp).Row - 1 Step 28
'↑B列で最終行を取得し、選択開始行と最後の表の選択終了行をstepで指定する（28行ごとに繰返す）

'↓10回繰り返す（繰り返す回数だけ「 Cells(i + 2, "C").Resize(, 84))」を9回追記)
'↓10回繰り返す（繰り返す回数だけ「 Cells(i + 2, "C").Resize(, 84))」を9回追記)
Set myRange = Union(myRange, Cells(i, "C").Resize(, 84), Cells(i + 2, "C").Resize(, 84), Cells(i + 4, "C").Resize(, 84), _
Cells(i + 6, "C").Resize(, 84), Cells(i + 8, "C").Resize(, 84), Cells(i + 10, "C").Resize(, 84), Cells(i + 12, "C").Resize(, 84), _
Cells(i + 14, "C").Resize(, 84), Cells(i + 16, "C").Resize(, 84), Cells(i + 18, "C").Resize(, 84))
Next i

Set Target = Intersect(Target, Range(myRange))

If Target Is Nothing Then
Exit Sub
Else
Cancel = True
With Target
If .Value = 1 Then
.ClearContents
.Interior.Pattern = xlPatternNone
Else
.Value = 1
.Font.ColorIndex = 3
.Interior.ColorIndex = 3
End If
End With
End If
End Sub

'=================================================

回答No.1

tom04

こんにちは！
画像が小さくて規則性が判りにくいので、
単純に色付きセルだけを選択するようにしてみました。

http://okwave.jp/qa/q8536916.html
のNo.2さんの方法と似ていますが、
Excel2010をお使いのようですので、Excel2010以降で使える「DisplayFormat」を使ってみました。
（条件付き書式で色がついている場合でも対応できます）

Sub Sample1()
Dim i As Long, k As Long, myRange As Range
For i = 5 To Cells(Rows.Count, "A").End(xlUp).Row 'A列で最終行を取得
If Cells(i, "C").DisplayFormat.Interior.ColorIndex <> xlNone Then 'C列で色付き行を判断
Set myRange = Cells(i, "C").Resize(, 84) ' 一旦　C～CH列最初の色付きセルを「myRange」にセット
Exit For 'ループを抜ける
End If
Next i
For k = i To Cells(Rows.Count, "A").End(xlUp).Row 'C列で色付きセルがあった行～A列最終行まで
If Cells(k, "C").DisplayFormat.Interior.ColorIndex <> xlNone Then
Set myRange = Union(myRange, Cells(k, "C").Resize(, 84))
End If
Next k
myRange.Select
End Sub

※　表外（項目行など）に色付きセルがある場合も選択されてしまいます。m（_ _）m

補足

ご回答ありがとうございます。
添付画像の表について、赤色セルの箇所(C9:CH9からC27:CH27まで１行おきに10行選択）を選択します。
そして、次表も同様に1行ごとに選択します。（C37:CH37からC55:CH55まで１行おきに10行選択）を選択を表数分だけ繰り返します。
ただし、1つ目の表の選択最終行から次表の選択開始行との行は選択不要のため（C28:CH36まで）無視します。

1つめの表の選択範囲：C9:CH9からC27:CH27
　次表までの選択不要な範囲：C28:CH36は無視する
2つ目の表：C37:CH37からC55:CH55
　次表までの選択不要な範囲：C256:CH64は無視する
3つ目の表：C65:CH65からC84:CH84
　次表までの選択不要な範囲：C85:CH91は無視する
　～以下次表までの繰り返し

表数が増えると、最後に選択した行とと次表見出し行との行数が10行あるため
選択範囲が全体的にずれてしまいました。
行数や表数が増えた場合、どの箇所を修正するのかを併せて教えていただけると助かります。
お手数お掛けいたしますが、よろしくお願い致します。