文字の入っているセルをカウントしていくマクロ作成

マクロ初心者です。
文字を検索する列の範囲はD~Fとし、検索開始セルはDとします。
検索結果を表示するセルの先頭セルはAとし、A～Cに結果を表示させます。
もしD2に文字があった場合、A１に”１”を表示させます。
E３に文字があった場合は、A３に”１”を、B３に”１”を表示。
E５に文字があった場合、E列に文字が入ったのが２回目となる為、A５に”１”を、B５に”２”と表示。

上記のように、それぞれの列に何個文字があったのかカウントしていくマクロを作成したいのですが、作成できずに困っています。
よろしくお願いします。

No.1 回答者： Sayakonomimoto 回答日時： 2014/05/28 11:58

マクロを作る必要があるのでしょうか。

関数で十分かと　「=COUNTA(B:B)」　とか。

また、マクロは自動記録…ですが…VBAでしょうか？

No.2 回答者： mt2008 回答日時： 2014/05/28 14:17

マクロでやる理由があるのでしょうか？

関数ならA2セルに↓を入れて、A2:C6にコピーで出来ます。
=IF(COUNTA(D$2:D2)=0,"",COUNTA(D$2:D2))

No.3 回答者： eden3616 回答日時： 2014/05/28 15:36

>もしD2に文字があった場合、A１に”１”を表示させます。

>E３に文字があった場合は、A３に”１”を、B３に”１”を表示。
>E５に文字があった場合、E列に文字が入ったのが２回目となる為、A５に”１”を、B５に”２”と表示。

画像は現状（上手くできていない状態）でしょうか？
目的（最終形）でしょうか？


>E５に文字があった場合、E列に文字が入ったのが２回目となる為、A５に”１”を、B５に”２”と表示。

目的であると解釈するのであれば、質問内容と異なっております。
画像ではB5に「3」、質問内容では「2」


■画像の結果を表現したいのであれば・・・

【関数で処理】

A1セルに「=IF(COUNTA(D$1:D1)=0,"",COUNTA(D$1:D1))」を入力して
C5までオートフィル（コピー）してください。

【VBAで処理】

(1)エクセル関数を使用するなら

Sub test1()
Dim cnt As Long, i As Long, j As Long
For i = 1 To 3
For j = 1 To 5
Cells(j, i).ClearContents
cnt = WorksheetFunction.CountA(Range(Cells(1, i + 3), Cells(j, i + 3)))
If cnt > 0 Then Cells(j, i) = cnt
Next j
Next i
End Sub

(2)数えるなら

Sub test2()
Dim cnt As Long, i As Long, j As Long, l As Long
For i = 1 To 3
For j = 1 To 5
Cells(j, i).ClearContents
For l = 1 To j
If Cells(l, i + 3) <> "" Then
Cells(j, i) = Cells(j, i) + 1
End If
Next l
Next j
Next i
End Sub



■文章の結果を表示したいのであれば・・・・

以下の仕様と解釈しております
・対象が空白であれば上の合計値を継承
・連続して文字がある部分を合計範囲としてカウント

【関数で処理】

A1のセルに「=IF(ROW()=1,IF(D1<>"",1,""),IF(AND(D1<>"",OFFSET(D1,-1,0)=""),1,IF(OFFSET(A1,-1,0)="","",IF(D1<>"",OFFSET(A1,-1,0)+1,OFFSET(A1,-1,0)))))」を入力して
C5までオートフィル。

【VBAで処理】

Sub test3()
Dim cnt As Long, i As Long, j As Long, l As Long
For i = 1 To 3
For j = 1 To 5
Cells(j, i).ClearContents
l = j
Do While Cells(l, i + 3) <> ""
Cells(j, i) = Cells(j, i) + 1
l = l - 1
If l = 0 Then Exit Do
Loop
If j > 1 And Cells(j, i + 3) = "" Then Cells(j, i) = Cells(j - 1, i)
Next j
Next i
End Sub

て感じでしょうか。

No.4 ベストアンサー 回答者： eden3616 回答日時： 2014/05/28 15:49

失礼しました。

2行目が開始行であるところを、1行目からと見間違え、
ご質問者の文章と画像が1行ズレていると勘違いしておりました。

ですが、C5、C6に1が入っていないように見えますが。


【関数で処理】

A2セルに「=IF(COUNTA(D$2:D2)=0,"",COUNTA(D$2:D2))」を入力して
C6までオートフィル（コピー）してください。

【VBAで処理】

(1)エクセル関数を使用するなら

Sub test1()
Dim cnt As Long, i As Long, j As Long
For i = 1 To 3
For j = 2 To 6
Cells(j, i).ClearContents
cnt = WorksheetFunction.CountA(Range(Cells(1, i + 3), Cells(j, i + 3)))
If cnt > 0 Then Cells(j, i) = cnt
Next j
Next i
End Sub

(2)数えるなら

Sub test2()
Dim cnt As Long, i As Long, j As Long, l As Long
For i = 1 To 3
For j = 2 To 6
Cells(j, i).ClearContents
For l = 1 To j
If Cells(l, i + 3) <> "" Then
Cells(j, i) = Cells(j, i) + 1
End If
Next l
Next j
Next i
End Sub

この回答へのお礼

回答ありがとうございました。
教えていただいた内容で無事に作成できました！

お礼日時：2014/05/28 20:53