| |
▼boss さん：
Dictionary で制御する案も２つほどアップしておきます。
コードでは K列 13行目から最終行までの間で 7行ごとに処理しています。
Sample2,Sample3 、基本的に同じことをしているんですが、Sample2 のほうは
取得する あああ アドレスを Range("K13,K20,K27,・・・") といったようにしています。
この Range内のアドレス文字列が 255桁を超えるとエラーになります。
そういう心配があるなら、Sample2 のように該当のセルを１つずつ取り出して処理することが
必要になります。
Sub Sample2()
Dim dic As Object
Dim i As Long
Dim mx As Long
Dim sh1 As Worksheet
Dim c As Range
Dim g As Range
Set sh1 = Sheets("Sheet1")
Set dic = CreateObject("Scripting.Dictionary")
mx = sh1.Range("K" & Rows.Count).End(xlUp).Row
For i = 13 To mx Step 7
Set c = sh1.Cells(i, "K")
Select Case c.Value
Case "最終": Set g = c
Case "あああ": dic(c.Address(False, False)) = True
End Select
Next
If g Is Nothing Then
MsgBox "最終 がありません" & vbLf & "処理を打ち切ります"
ElseIf dic.Count = 0 Then
MsgBox "あああ がありません" & vbLf & "処理を打ち切ります"
Else
MsgBox "最終 は " & g.Address(External:=True) & vbLf & _
"あああ は " & sh1.Range(Join(dic.keys, ",")).Address(External:=True)
End If
End Sub
Sub Sample3()
Dim dic As Object
Dim i As Long
Dim mx As Long
Dim sh1 As Worksheet
Dim c As Range
Dim g As Range
Dim d As Variant
Set sh1 = Sheets("Sheet1")
Set dic = CreateObject("Scripting.Dictionary")
mx = sh1.Range("K" & Rows.Count).End(xlUp).Row
For i = 13 To mx Step 7
Set c = sh1.Cells(i, "K")
Select Case c.Value
Case "最終": Set g = c
Case "あああ": Set dic(c.Address(False, False)) = c
End Select
Next
If g Is Nothing Then
MsgBox "最終 がありません" & vbLf & "処理を打ち切ります"
ElseIf dic.Count = 0 Then
MsgBox "あああ がありません" & vbLf & "処理を打ち切ります"
Else
MsgBox "最終 は " & g.Address(External:=True) & vbLf & _
"いまから あああ のセルを１つずつ表示します"
For Each d In dic.items
MsgBox d.Address(External:=True)
Next
End If
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
