エクセルで連続入力セルの頻度分布

質問

いろいろやっているのですが、うまくいかないので、ぜひご教授願います。

　　01　02　03　04　05　06　07　08　09　10　11　12　13　14　15　16　　　　2　3　4　5
A　○　○　　　　　　○　○　○　　　 ○　○　○　　　 ○　○　○　○　　　　1　2　1　0
B　　　 ○　　　 ○　　　　　　○　○　○　○　　　　　　　　 ○　○　　　　　　 1　0　1　0　
C　　　　　　　　　　　○　○　○　○　○　　　　　　　　　　　　　　　　　　　　　0　0　0　1

のように、セルの横方向に連続して入力された個数を知りたいのですが、簡単でよい方法を教えてください。
実際は○では無く、複数の文字が入りますが、文字の区別をする予定はありません。　
よろしくお願いします。

回答No.6

tom04

No.3・5です！
何度もごめんなさい。
No.5のコードで一部間違いがありました。

前回のコードは削除して↓に変更してください。

Sub test2() 'この行から
Dim i As Long, j As Long, k As Long, M As Long
i = Cells(Rows.Count, 1).End(xlUp).Row
j = ActiveSheet.UsedRange.Columns.Count
Range(Cells(2, 19), Cells(i, j)).ClearContents
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To 17
If Cells(i, j) <> "" Then
k = j
Do While Cells(i, k) <> ""
k = k + 1
M = M + 1
Loop
If M > 1 Then
Cells(i, M + 17) = Cells(i, M + 17) + 1
j = k
End If
End If
M = 0 '←ココに移動させました。
Next j
Next i
End Sub 'この行まで

失礼しました。m(_ _)m

回答No.5

tom04

No.3です。

＞出来ればsheet１で結果を見たかったので・・・

とありますので、データはA列が項目列で16列（Q列）までしかない！というコトですかね？

そうであればもっと簡単になります。
とりあえず、S列以降に表示するようにしてみました。

画面左下の操作したいSheet見出し上で右クリック　→　コードの表示　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
前回同様、Alt＋F8キー　→　マクロ　→　マクロ実行です。

Sub test2() 'この行から
Dim i As Long, j As Long, k As Long, M As Long
i = Cells(Rows.Count, 1).End(xlUp).Row
j = ActiveSheet.UsedRange.Columns.Count
Range(Cells(2, 19), Cells(i, j)).ClearContents
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To 17
If Cells(i, j) <> "" Then
k = j
Do While Cells(i, k) <> ""
k = k + 1
M = M + 1
Loop
End If
If M > 1 Then
Cells(i, M + 17) = Cells(i, M + 17) + 1
j = k
M = 0
End If

Next j
Next i
End Sub 'この行まで

こんなんではどうでしょうか？m(_ _)m

回答No.4

noname#204879

添付図参照
補助シート Sheet2 において、
１．セル B2 に式 =IF(Sheet1!B2="","XX",Sheet1!B2) を入力して、此れを右方にズズーッと(列Ｑまで)ドラッグ＆ペースト
２．セル R2 に次式を入力
　　="X"&B2&C2&D2&E2&F2&G2&H2&I2&J2&K2&L2&M2&N2&O2&P2&Q2&"X"
３．範囲 B2:R2 を下方にズズーッとドラッグ＆ペースト
４．セル S2 に式 ="X"&REPT("○",Sheet1!S$1)&"X" を入力して、此れをズズーッと右方にズズーッと(列Ｖまで)ドラッグ＆ペースト

Sheet1 において、
５．セル S2 に次式を入力して、此れを右方および下方にズズーッとドラッグ＆ペースト
　　=((LEN(Sheet2!$R2)-LEN(SUBSTITUTE(Sheet2!$R2,Sheet2!S$2,""))))/(S$1+2)

お礼

お礼が遅くなり申し訳ありません。
色々と試行錯誤していますので、後ほど試させていただきます。
ありがとうございました。

回答No.3

tom04

こんばんは！
VBAになってしまいますが・・・
一例です。

↓の画像のようにSheet1のデータをSheet2に表示するようにしてみました。
尚、Sheet2の項目行・項目列（薄い黄色部分）はあらかじめ入力されているという前提です。

Alt＋F11キー　→　メニュー　→　挿入　→　「標準モジュール」　→　VBE画面が出ますので
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub test() 'この行から
Dim i As Long, j As Long, k As Long, M As Long
Dim ws1 As Worksheet, ws2 As Worksheet
Set ws1 = Worksheets("Sheet1") '←「Sheet1」は実際のシート名に！
Set ws2 = Worksheets("Sheet2") '←「Sheet2」の部分も・・・
i = ws2.UsedRange.Rows.Count
j = ws2.UsedRange.Columns.Count
Range(ws2.Cells(2, 2), ws2.Cells(i, j)).ClearContents
For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To ws1.Cells(i, Columns.Count).End(xlToLeft).Column
If ws1.Cells(i, j) <> "" Then
k = j
Do While ws1.Cells(i, k) <> ""
k = k + 1
M = M + 1
Loop
ws2.Cells(i, M + 1) = ws2.Cells(i, M + 1) + 1
j = k
M = 0
End If
Next j
Next i
End Sub 'この行まで

こんな感じではどうでしょうか？m(_ _)m

お礼

お礼が遅くなり申し訳ありません。
出来ればsheet１で結果を見たかったので
今後の為の勉強で利用させて頂きます。
ありがとうございました。

回答No.2

KURUMITO

かなり式が複雑になりそうなので作業シートを作って対応します。
シート1がお示しの表でB1セルから例えばQ1セルまでに01,02・・・のように数値が入力されており、A2セルから下方にはA,B,Cといった項目名が入力されているとします。
○などの入力はB列からQ列までの2行目以降に入力されているとします。
そこで作業用のシートですが例えばシート2に作成するとしてB2セルには次の式を入力して右横方向のQ2セルまでドラッグコピーしたのちに下方にもドラッグコピーします。

=IF(AND(Sheet1!B2<>"",Sheet1!C2<>""),SUM(A2)+1,IF(AND(Sheet1!B2<>"",Sheet1!C2=""),1000+SUM(A2)+1,""))

ここでSUM関数を使っているのは例えばシート2のA列に項目名などが入力されたとしてもエラーが出ないようにするためです。
作業シートの操作は終わって、連続入力セルのデータを表示させるために例えばシート1のS1セルに2、L1セルに3、M1セルに4、N1セルに5のように連続入力されているセルの数を入力します。
その上でS2セルには次の式を入力したのちに右横方向にドラッグコピーしたのちに下方にもドラッグコピーします。

=IF(OR($A2="",S$1=""),"",COUNTIF(Sheet2!$B2:$Q2,1000+S$1))

これで対応する各行での連続入力セルの頻度分布が表示されます。

お礼

お礼が遅くなり申し訳ございません。
かなり良い感じに仕上がってきました。
ありがとうございます。

回答No.1

aokii

COUNTA関数を使ってみてください。