EXCEL VBAで特定のセルの値による判定について

質問

すいません、EXCEL VBAで質問があります。

A1～A9　空欄
A10 "赤"
A11～A16　空欄
A17　"青"
A18～A21 空欄
A22　"青"
A23～A35 空欄
A36 "赤"
・・・

A列の1000行までの間にランダムに赤か青の値が入っています。
A列の空欄のセルについて、下のセルを見ていき、
最初に来る値が赤であれば、それまでの空欄に"りんご"、青であれば"みかん"という値を入れる処理をVBAでやるにはどうしたらいいのでしょうか。
上の例でいうと、A1～A9及びA23～A35のセルには"りんご"、A11～A16及びA18～A21のセルには"みかん"と入ります。

do until～loopやfor～nextでやろうとしましたがどうにもうまくいきません。
よろしくお願いいたします。

回答No.1

xls88 · ベストアンサー

一例です。
SpecialCells と Areas を使ってみました。

Sub test1()
　　Dim i As Long

　　With Range("A1:A1000").SpecialCells(xlCellTypeBlanks)
　　　　For i = 1 To .Areas.Count
　　　　　　If .Areas(i)(.Areas(i).Rows.Count + 1).Value = "赤" Then
　　　　　　　　.Areas(i).Value = "りんご"
　　　　　　ElseIf .Areas(i)(.Areas(i).Rows.Count + 1).Value = "青" Then
　　　　　　　　.Areas(i).Value = "みかん"
　　　　　　End If
　　　　Next i
　　End With
End Sub

お礼

ありがとうございました。SpecialCellsの使い方がよくわからなかったのですが、教えていただいたコードで勉強しました。
またよろしくお願いいたします。

回答No.4

onlyrom

＞do until～loopやfor～nextでやろうとしましたがどうにもうまくいきません。

質問するときはその上手くいかないコードをアップしましょう。
それを修正加筆すれば質問者自身が考えたコードが完成することになりますので。

今回のことをFor Nextでやる場合は、
A1からではなく最終セル（例えば、A1000）から処理するのがコツです。

'------サンプル　１　---------------------

Sub Test333()
　Dim myValue
　Dim R As Long
　Dim LastRow As Long

　LastRow = Cells(Rows.Count, "A").End(xlUp).Row

　For R = LastRow To 1 Step -1
　　　If Cells(R, "A").Value = "赤" Then
　　　　　myValue = "りんご"
　　　ElseIf Cells(R, "A").Value = "青" Then
　　　　　myValue = "みかん"
　　　Else
　　　　　Cells(R, "A").Value = myValue
　　　End If
　Next R

End Sub

'------サンプル　２　　--------------------

Sub Test555()
　Dim myValue
　Dim R As Long
　Dim LastRow As Long

　LastRow = Cells(Rows.Count, "A").End(xlUp).Row

　For R = LastRow To 1 Step -1
　　　Select Case Cells(R, "A").Value
　　　　　Case "赤"
　　　　　　　myValue = "りんご"
　　　　　Case "青"
　　　　　　　myValue = "みかん"
　　　　　Case Else
　　　　　　　Cells(R, "A").Value = myValue
　　　End Select
　Next R

End Sub
'----------------------------------------------

以上。

お礼

ありがとうございました。出来ました。
今後は作りかけのコードでもアップするようにします。

回答No.3

n-jun

Sub try()
Dim r As Range

For Each r In Range("A:A").SpecialCells(xlCellTypeBlanks).Areas

r.Value = IIf(r.Resize(1).Offset(r.Cells.Count).Value = "赤", "りんご", "みかん")

Next

End Sub

ご参考になれば。（エラー処理ないですけど）

回答No.2

hige_082

下から上へ処理してみました

Sub test()
Dim i As Long
Dim a As String
a = ""
For i = Range("a65536").End(xlUp).Row To 1 Step -1
If Cells(i, 1).Value = "" Then
Cells(i, 1).Value = a
Else
Select Case Cells(i, 1).Value
Case "赤"
a = "りんご"
Case "青"
a = "みかん"
Case Else
a = ""
End Select
End If
Next i
End Sub

以上です