EXCEL VBA における個数のカウント方法について

すいませんEXCEL　VBAについて質問があります。
　　　　A列　　
1行　　みかん
2行　　みかん
3行　　(空欄)
4行　　みかん
5行　　ぶどう
6行　　みかん
7行　　みかん
8行　　ぶどう
9行　　(空欄)
・
・
50行

A列は「みかん」若しくは「ぶどう」の値又は空欄のいずれかになっている。
空欄は無視して（1行～4行はみかんが３つ連続で並んだと考える）、
50 行までの間に「みかん」が最大で何回連続で並んだかを調べ、その最大の値をB1セルに入れる。
これをVBAで処理するにはどうしたらいいのでしょうか。
For ～NextとIfで条件分岐
というような形になるのかなと思ったのですが
どうしても思い浮かびません。
どうぞよろしくお願いします。

No.3 ベストアンサー 回答者： end-u 回答日時： 2009/06/25 23:02

Dim r　 As Range

Dim cnt As Long
Dim x　 As Long

With ActiveSheet
　　For Each r In .Range("A1:A50")
　　　　If r.Value = "みかん" Then
　　　　　　cnt = cnt + 1
　　　　ElseIf r.Value <> "" Then
　　　　　　If cnt > x Then
　　　　　　　　x = cnt
　　　　　　End If
　　　　　　cnt = 0
　　　　End If
　　Next
　　If cnt > x Then
　　　　x = cnt
　　End If
　　.Range("B1").Value = x
End With

「空欄ではなく、かつ　"みかん"ではない」という条件の時にカウントアップした変数cntをリセットする。
という点に着目したほうが良さそう。
で、リセットの前に最大値かどうか調べて最大値だったらその変数xを置き換えておく。
最後のセルA50が"みかん"で終わる可能性もあるなら、そこが最大値かどうかのチェックも必要です。

この回答へのお礼

ありがとうございました。やっと理解できました。
空欄でないかつみかんでないときにcntをリセットするというところまでは自分で出来たのですが、
リセット前に最大値の変数ｘを置き換えるという処理がわかりませんでした。
どうもありがとうございました。

お礼日時：2009/06/26 00:22

No.6 回答者： Wendy02 回答日時： 2009/06/26 00:19

こんばんは。

こちらの場合は、カタカナや半角比較でも可能にしていること、文字列の後ろに空白が入っても、空白を取って比較する、というのが利点かな？後は、他の人と変わらないです。ただ、これは、人に教えるためではなくて、あくまでも、自分の練習、自分で作ってみないと分からない部分があります。

'----------------------------------------

Sub TestCount1()
　　Dim i As Long
　　Dim k As Long
　　Dim mx As Long
　　Dim flg As Boolean
　　Const sFND As String = "みかん"
　　
　　For i = 1 To 50
　　　　If StrComp(Trim(Cells(i, 1).Value), sFND, 1) = 0 And flg = False Then
　　　　　　flg = True
　　　　　　k = 1
　　　　ElseIf StrComp(Trim(Cells(i, 1).Value), sFND, 1) = 0 Then
　　　　　　k = k + 1
　　　　ElseIf Cells(i, 1).Value <> "" _
　　　　　　And StrComp(Trim(Cells(i, 1).Value), sFND, 1) <> 0 Then
　　　　　　flg = False
　　　　　　If mx < k Then
　　　　　　　　mx = k
　　　　　　End If
　　　　End If
　　Next i
　　Cells(1, 2).Value = mx
End Sub

'-------------------------------------------

この回答へのお礼

ありがとうございました。構造がやっと理解できました。
最大値を変数ｍｘとして置き換えるというところが自分では思い浮かびませんでした。
またわからないことがあったらお願いいたします。

お礼日時：2009/06/26 00:27

No.5 回答者： rukuku 回答日時： 2009/06/25 23:34

こんばんは

こんな感じで以下がでしょうか？
「マクロの記録」で作りました。

Sub Macro1()
Range("I1").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-8]=""みかん"",1,0)"
Range("I2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-8]=""みかん"",R[-1]C+1,IF(RC[-8]="""",R[-1]C,0))"
Selection.AutoFill Destination:=Range("I2:I50"), Type:=xlFillDefault
Range("I2:I50").Select
ActiveWindow.ScrollRow = 1
Range("B1").Select
ActiveCell.FormulaR1C1 = "=MAX(RC[7]:R[49]C[7])"
End Sub

No.4 回答者： imogasi 回答日時： 2009/06/25 23:20

丸投げ質問なので、考え方だけ書く。

まどろっこしいが。
A列（1セル）の直前行の値を保持する変数を１つ用意する。
またその行までの最多連の数を保持する変数を用意する
途中経過の連の数を保持する変数を用意する。
ーー
For Nextで最終行までA列を順次読むが
直前行と現在行を比較して変わったら
今回の連と過去の連を比べ、大きければ過去最多を更新
（等しいか・小さけれ過去最多ばいらわない。）
その時A列のセルが、空白セルならば、無いものとして処理を飛ばす
連の数もそのまま
過去最多もそのまま、
直前行もそのまま
で次行の処理に移る。
また直前行と現在行を比較して変わったら、連の数を１から始める。
直前行は現在行の値にして次の行処理に移る
ーーー。
最初行は比較対照が無いので特別処理をする。
最終行は、この処理が、１種の溜め込み処理なので、後じまいが必要（最多連の処理など）。

No.2 回答者： okormazd 回答日時： 2009/06/25 22:35

Sub test()

n = 0
nm = 0
For r = 1 To 50
s = Cells(r, 1)
If s <> "" Then
If s = "みかん" Then
n = n + 1
Else
If n > nm Then
nm = n
n = 0
End If
End If
End If
Next

Cells(1, 2) = nm

End Sub

No.1 回答者： fujillin 回答日時： 2009/06/25 22:23

考え方のヒントです。

たとえば「みかん」を対象にした場合、

1）カウンターと最大値を控える変数を用意しておく。

2）ループの始めにカウンターをクリア（0にする）

3）上から（下からでもよい）順に見て行って、みかんが連続している間は
　カウンターをインクリメントする。（+1する＝連続数を数える）

4）連続が途切れた時に、カウンターの値と最大値を比較して、大きいほう
　を最大値に保存する。
　同時にカウンターをクリアする。（0に戻す）

5）以上を、データがある間ループさせて、終わったときに最大値に入って
　いる値が、求めたい回数となっている。

（「ぶどう」が対象の場合でも同じですね）