Ｅｘｃｅｌの ＶＢＡ 基準となるセルの設定について

Sub Sample1()
Dim c As Range, myRng As Range, myCnt As Long
With Range("H11")
Set myRng = Union(.Offset(, -1), .Offset(-1), .Offset(, 1), .Offset(1))
For Each c In myRng
If c < .Value Then
myCnt = myCnt + 1
End If
Next c
Select Case myCnt


Case 3
.Interior.ColorIndex = 1 '←「黒]
.Font.ColorIndex = 2 '←「白」
Case 2
.Interior.ColorIndex = 6 '←「黄」
.Font.ColorIndex = 3 '←「赤」
Case 1
.Interior.ColorIndex = 5 '←「青」
.Font.ColorIndex = 2
Case 0
.Interior.ColorIndex = 3 '←「赤]
.Font.ColorIndex = 2 '←「白」

Case Else
.Interior.ColorIndex = xlNone
.Font.ColorIndex = xlAutomatic
End Select
End With
End Sub


前回の質問で上記のコードを押していただきました。

With Range("H11")の設定なんですが、Ｈ１１しか比較できなく

たとえば、Ｈ６　Ｊ６　Ｌ６と規則性があります。（一個飛ばしです）

その時にWith Range("H11")をcellsでＨ６～ＡＬ６までを表すことはできますか？

ほぼ丸投げですが、いま、自分でもネット、本で調べてますが、できるのか、どうかもわからないので、ご教示お願いします。

No.2 ベストアンサー 回答者： tom04 回答日時： 2016/05/03 21:02

こんばんは！

お示しのコードに手を加えてみました。

Sub Sample2()
Dim j As Long '★
Dim c As Range, myRng As Range, myCnt As Long
For j = 8 To Cells(6, Columns.Count).End(xlToLeft).Column Step 2 'H6セルから1列おき★
With Cells(6, j) '←変更☆
Set myRng = Union(.Offset(, -1), .Offset(-1), .Offset(, 1), .Offset(1))
For Each c In myRng
If c < .Value Then
myCnt = myCnt + 1
End If
Next c
MsgBox myCnt
Select Case myCnt
Case 3
.Interior.ColorIndex = 1 '←「黒]
.Font.ColorIndex = 2 '←「白」
Case 2
.Interior.ColorIndex = 6 '←「黄」
.Font.ColorIndex = 3 '←「赤」
Case 1
.Interior.ColorIndex = 5 '←「青」
.Font.ColorIndex = 2
Case 0
.Interior.ColorIndex = 3 '←「赤]
.Font.ColorIndex = 2 '←「白」
Case Else
.Interior.ColorIndex = xlNone
.Font.ColorIndex = xlAutomatic
End Select
End With
myCnt = 0 '←「myCnt」をクリア★
Next j '★
End Sub

※　コード内の「★」の行が追加で「☆」が変更です。m(_ _)m

この回答へのお礼

ありがとうございました。
完成しました。

お礼日時：2016/05/04 09:14

No.3 回答者： tom04 回答日時： 2016/05/03 21:59

No.2です。

たびたびごめんなさい。
前回のコードの
＞Next c
の下にある
＞MsgBox myCnt
の1行は削除してください。

こちらで動きを確認するために余計なコードを入れていました。

どうも失礼しました。m(_ _)m

No.1 回答者： siffon9 回答日時： 2016/05/03 11:04

こんな感じで如何でしょう？

----------------
Dim rs As Range
Dim r As Range
Dim i As Long

Set rs = Range("H11") ' 基本のセル
Set r = rs.Offset(-5) ' H6
Set rs = Union(rs, r) ' rs に H6を追加する。

' rs に J6,……, AL6を追加する
For i = 1 To 15
　　Set r = r.Offset(, 2)
　　Set rs = Union(rs, r)
Next i
' この時点で、rs = H11,H6,J6,……, AL6


For Each r In rs ' rsの要素を一つずつとりだす
　　With r ' With Range("H11")の代わり

　　　　' With～End With間に各要素についての処理を記載する

　　End With
Next

この回答へのお礼

回答ありがとうございました。

お礼日時：2016/05/04 09:14