みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

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


50行

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

投稿日時 - 2009-06-25 21:58:42

QNo.5074642

困ってます

質問者が選んだベストアンサー

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が"みかん"で終わる可能性もあるなら、そこが最大値かどうかのチェックも必要です。

投稿日時 - 2009-06-25 23:02:50

お礼

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

投稿日時 - 2009-06-26 00:22:08

ANo.3

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(6)

ANo.6

こんばんは。

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

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

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:19:32

お礼

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

投稿日時 - 2009-06-26 00:27:27

ANo.5

こんばんは

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

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

投稿日時 - 2009-06-25 23:34:09

ANo.4

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

投稿日時 - 2009-06-25 23:20:16

ANo.2

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

投稿日時 - 2009-06-25 22:35:25

ANo.1

考え方のヒントです。
たとえば「みかん」を対象にした場合、

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

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

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

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

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

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

投稿日時 - 2009-06-25 22:23:28

あなたにオススメの質問