ExcelVBAで条件の追加

質問

条件(0.5以下)に一致するセルの個数を数えます。
CH1　CH2　CH3　CH4
1　5　　5　0.1　 5
2　5　　5　0.1　 5
3　0.1　5　5　　 0.1
4　0.1 5　5　 　0.1
5　0.1　5　5　 　0.1
6　5　　5　0.1　 0.1
7　0.1 5　0.1　 5
8　0.1　5　0.1　 0.1
9　5　　5　5 0.1
CH1の列の先頭行から数えていくと、0.5以下に一致するセルの個数はCH1では3個、2個となります。この3と2は足さずに別々に表示したいのです。
CH1が終わると、CH2→CH3→と繰り返します。
結果は以下のように列ごとに表にして示します。
CH1 CH2　CH3　CH4
3　　　　 2　 4
2　　　　 3　 2
今回は、以下の条件を追加したいのです。
「数えたセルの個数のうち、各列の先頭行や最終行を含むものは除く」
上の例でこの条件を追加しますと、CH3の2個、3個という結果のうち2個の方は先頭行を含んでいるので削除、CH4の結果のうち2個は最終行を含んでいるので削除、結果以下のようになります。
CH1 CH2　CH3　CH4
3　　　　3　 4
2　　　　
＜コードの一部＞
Dim 出力値 As Variant
Dim 出力先セル As Range
Dim Counter As Long 'カウンタ
Dim a As Long
For a = 1 To 5
Set 出力先セル = Cells(2, 7＋a)
For Each 出力値 In Range(Cells(32, a),Cells(60000, a)).Value
If 出力値 <= 0.5 Then
Counter = Counter + 1
ElseIf Counter <> 0 Then
出力先セル.Value = Counter '出力
Set 出力先セル = 出力先セル.Offset(1)
Counter = 0 'リセット
End If
Next
If Counter <> 0 Then
出力先セル.Value = Counter '出力
End If
Next
このif文の所に上記条件を追加したいのです。※先頭行(32行)と最終行(60000行)は固定

回答No.1

popesyu · ベストアンサー

最終行の判定は最後の
出力先セル.Value = Counter '出力
をなくしてしまえば解決するのではないかと。
この行がそもそも最終行の場合の出力の部分ですよね？多分。

先頭行の判定は、カウンターに1ずつ加算する方式ではなく、行と行の差を計算するとかのコードに変えるか、既存のままいくなら、フラグを立ててチェックするとかでしょうか。
例
※行数を数える必要があるため、出力値はRange型に変更しています。

Dim 出力値 As Range
Dim 出力先セル As Range
Dim Counter As Long 'カウンタ
Dim a As Long
For a = 1 To 5
Set 出力先セル = Cells(2,7+a)
For Each 出力値 In Range(Cells(32, a), Cells(60000, a))
If 出力値 <= 0.5 Then
　If 出力値.Row = 1 Then
　flag = 1
　End If
Counter = Counter + 1

ElseIf Counter <> 0 Then
If flag <> 1 Then
　出力先セル.Value = Counter '出力
　Set 出力先セル = 出力先セル.Offset(1)
Else
　flag = 0
End If
Counter = 0 'リセット
End If

Next

If Counter <> 0 Then
'出力先セル.Value = Counter '出力
Counter = 0
End If
Next

お礼

丁寧なお答え、ありがとうございました。
“フラグを立ててチェックする”事は、初心者ゆえに全く思いつかなかったので、ものすごい助かりました。
本当にありがとうございました。

回答No.2

snoopy64

最後のカウント分を出力しないのは、＃１さんのおっしゃるとおり、最後の部分をやらなければいいですね。

最初の部分については、「0.5を超える値を見つけたらカウントを許可」と考え、以下のようにしてみました。

Dim 出力値 As Variant
Dim 出力先セル As Range
Dim Counter As Long 'カウンタ
Dim a As Long
Dim 区切り発見 As Boolean
For a = 1 To 5
区切り発見 = False
Counter = 0
Set 出力先セル = Cells(2, 7 + a)
For Each 出力値 In Range(Cells(32, a), Cells(60000, a)).Value
If 出力値 <= 0.5 Then
If 区切り発見 Then
Counter = Counter + 1
End If
Else
区切り発見 = True
If Counter <> 0 Then
出力先セル.Value = Counter '出力
Set 出力先セル = 出力先セル.Offset(1)
Counter = 0 'リセット
End If
End If
Next
Next

頑張ってくださいヽ(^。^)ノ

お礼

丁寧なご回答、ありがとうございました。
「この回答は参考になった」ボタンを何度押しても反映されませんが（ごめんなさい）、ご参考にさせて頂きました。
ありがとうございました。