Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
12139 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【12001】種類分けされたセル個数を順に表記する方法を教えて下さい。 たけやん 04/3/21(日) 19:54 質問
【12003】Re:種類分けされたセル個数を順に表記する... カド 04/3/21(日) 21:55 回答
【12015】Re:種類分けされたセル個数を順に表記する... Asaki 04/3/22(月) 11:12 回答
【12051】Re:種類分けされたセル個数を順に表記する... たけやん 04/3/22(月) 22:56 お礼
【12056】Re:種類分けされたセル個数を順に表記する... Asaki 04/3/23(火) 9:40 回答
【12061】Re:種類分けされたセル個数を順に表記する... Asaki 04/3/23(火) 11:11 回答
【12145】Re:種類分けされたセル個数を順に表記する... たけやん 04/3/24(水) 22:56 お礼
【12001】種類分けされたセル個数を順に表記する方...
質問  たけやん  - 04/3/21(日) 19:54 -
引用なし
パスワード
   こんにちは、たけやんです。
初めて投稿します。どなたか教えて下さい。

図１
　　Ａ　Ｂ　Ｃ　Ｄ　Ｅ　Ｆ
１　当　×　×　×　当　当
２　当　×　×　当　×　×
３　×　×　×　×　×　×

このようなデータがあるとします。
「当」の連続数、「×」の連続数を
下記の様な形で取れないかと．．．

図２

　　Ａ　Ｂ　Ｃ　Ｄ　Ｅ　Ｆ
４　１　３　３　２　１　８

ちなみにＦ１セルの続きはＡ２セルへとなります。
ですからＥ１、Ｆ１、Ａ２が連続する「当」
の数としてＣ４セルにカウントする形です。

Ｅ２〜Ｆ３についても同様です。

図２への入力はＡ４からどんどん詰めて行く形で表記
出来れば、なお嬉しいです。
【12003】Re:種類分けされたセル個数を順に表記す...
回答  カド E-MAIL  - 04/3/21(日) 21:55 -
引用なし
パスワード
   こんな感じ

Sub bbb()
　　cnt = 1
　　cnt1 = 1
　　Set aa = Cells(1, 1)
　　For m = 1 To 3
　　
　　　　For n = 1 To 6
　　　　　　If n <> 6 Then
　　　　　　　　If aa = aa.Offset(0, 1) Then

　　　　　　　　　　cnt = cnt + 1

　　　　　　　　Else
　　　　　　　　　　MsgBox cnt
　　　　　　　　　　Cells(4, cnt1) = cnt
　　　　　　　　　　cnt1 = cnt1 + 1

　　　　　　　　　　cnt = 1

　　　　　　　　End If
　　　　　　　　Set aa = aa.Offset(0, 1)
　　　　　　Else
　　　　　　　　If aa = aa.Offset(1, -5) Then

　　　　　　　　　　cnt = cnt + 1

　　　　　　　　Else
　　　　　　　　　　MsgBox cnt
　　　　　　　　　　Cells(4, cnt1) = cnt
　　　　　　　　　　cnt1 = cnt1 + 1

　　　　　　　　　　cnt = 1
　　　　　　　　End If
　　　　　　　　
　　　　　　End If
　　　　　　
　　　　Next n
　　Set aa = aa.Offset(1, -5)
　　Next m

End Sub
【12015】Re:種類分けされたセル個数を順に表記す...
回答  Asaki  - 04/3/22(月) 11:12 -
引用なし
パスワード
   こんにちは。

↓こんな感じでは如何でしょうか？
Sub test()
　　Dim rngLoop　　 As Range
　　Dim strCnt　　　As String
　　Dim varTmp　　　As Variant
　　Dim lngCnt　　　As Long
　　Dim strPre　　　As String

　　lngCnt = 0
　　strPre = ""
　　For Each rngLoop In Range("A1:F3")
　　　　'1つ前のセルと同値ならカウンタをカウントアップ
　　　　If rngLoop.Value = strPre Then
　　　　　　lngCnt = lngCnt + 1

　　　　'値が変わったらカンマを挟んで個数を文字列に退避
　　　　Else
　　　　　　If lngCnt <> 0 Then strCnt = strCnt & "," & lngCnt
　　　　　　lngCnt = 1
　　　　　　strPre = rngLoop.Value
　　　　End If
　　Next rngLoop
　　'最終データの書き込み
　　strCnt = Mid(strCnt, 2) & "," & lngCnt
　　'カンマで区切って配列に格納
　　varTmp = Split(strCnt, ",")
　　'配列の内容をセルに展開
　　Cells(4, 1).End(xlToRight).ClearContents
　　Cells(4, 1).Resize(, UBound(varTmp) + 1).Value = varTmp
　　'配列初期化
　　Erase varTmp
End Sub
【12051】Re:種類分けされたセル個数を順に表記す...
お礼  たけやん  - 04/3/22(月) 22:56 -
引用なし
パスワード
   ▼Asaki さん：
>こんにちは。
>
>↓こんな感じでは如何でしょうか？
>Sub test()
>　　Dim rngLoop　　 As Range
>　　Dim strCnt　　　As String
>　　Dim varTmp　　　As Variant
>　　Dim lngCnt　　　As Long
>　　Dim strPre　　　As String
>
>　　lngCnt = 0
>　　strPre = ""
>　　For Each rngLoop In Range("A1:F3")
>　　　　'1つ前のセルと同値ならカウンタをカウントアップ
>　　　　If rngLoop.Value = strPre Then
>　　　　　　lngCnt = lngCnt + 1
>
>　　　　'値が変わったらカンマを挟んで個数を文字列に退避
>　　　　Else
>　　　　　　If lngCnt <> 0 Then strCnt = strCnt & "," & lngCnt
>　　　　　　lngCnt = 1
>　　　　　　strPre = rngLoop.Value
>　　　　End If
>　　Next rngLoop
>　　'最終データの書き込み
>　　strCnt = Mid(strCnt, 2) & "," & lngCnt
>　　'カンマで区切って配列に格納
>　　varTmp = Split(strCnt, ",")
>　　'配列の内容をセルに展開
>　　Cells(4, 1).End(xlToRight).ClearContents
>　　Cells(4, 1).Resize(, UBound(varTmp) + 1).Value = varTmp
>　　'配列初期化
>　　Erase varTmp
>End Sub

色々教えて貰いありがとうございます。
早速マクロ登録して実行してみました。
自分の知識が無い為に上手く理解出来てないようです。

差し支えなければもう少し手助けしてください。

実際のデータは”統計”というシートのR5:AC107の範囲に記されてます。
これをR110:AC150の間に変換した数値を入れたいのですが、知識不足の
為、せっかく頂いたマクロのどこを修正して良いかもわからない状況です。

よろしかったら、ここら辺も教えて下さい。
【12056】Re:種類分けされたセル個数を順に表記す...
回答  Asaki  - 04/3/23(火) 9:40 -
引用なし
パスワード
   >実際のデータは”統計”というシートのR5:AC107の範囲に記されてます。
現在のコードでは、処理対象のシートの指定はしていませんので、
アクティブになっているシートに対して実行されます。
”統計”シートをアクティブにして実行できない状況であれば、
全ての Range() と Cells() の前に
Worksheets("統計").　←「.」を忘れないでください
をつけてみてください。

また、データが入っている範囲の指定は
>For Each rngLoop In Range("A1:F3")
の部分ですので、
For Each rngLoop In Range("R5:AC107")
と変えてください。


>これをR110:AC150の間に変換した数値を入れたい
現在のものは、ある1行に、横向きに結果の数値を出力していますので、
矩形の範囲に出力するように変更します。
>Cells(4, 1).End(xlToRight).ClearContents
>Cells(4, 1).Resize(, UBound(varTmp) + 1).Value = varTmp
 ↓
Range("R110:AC150").ClearContents
lngCnt = 1
With Range("R110:AC150")
　　For Each v In varTmp
　　　　.Cells(lngCnt).Value = v
　　　　lngCnt = lngCnt + 1
　　Next v
End With


全部あわせると、こんな感じです。
Sub test()
　　Dim rngLoop　　 As Range
　　Dim strCnt　　　As String
　　Dim varTmp　　　As Variant
　　Dim lngCnt　　　As Long
　　Dim strPre　　　As String
　　Dim v　　　　　 As Variant

　　lngCnt = 0
　　strPre = ""
　　For Each rngLoop In Range("R5:AC107")
　　　　'1つ前のセルと同値ならカウンタをカウントアップ
　　　　If rngLoop.Value = strPre Then
　　　　　　lngCnt = lngCnt + 1

　　　　'値が変わったらカンマを挟んで個数を文字列に退避
　　　　Else
　　　　　　If lngCnt <> 0 Then strCnt = strCnt & "," & lngCnt
　　　　　　lngCnt = 1
　　　　　　strPre = rngLoop.Value
　　　　End If
　　Next rngLoop
　　'最終データの書き込み
　　strCnt = Mid(strCnt, 2) & "," & lngCnt
　　'カンマで区切って配列に格納
　　varTmp = Split(strCnt, ",")
　　'配列の内容をセルに展開
　　Range("R110:AC150").ClearContents
　　lngCnt = 1
　　With Range("R110:AC150")
　　　　For Each v In varTmp
　　　　　　.Cells(lngCnt).Value = v
　　　　　　lngCnt = lngCnt + 1
　　　　Next v
　　End With
　　
　　'配列初期化
　　Erase varTmp
End Sub
【12061】Re:種類分けされたセル個数を順に表記す...
回答  Asaki  - 04/3/23(火) 11:11 -
引用なし
パスワード
   数えながら出力するほうが、簡単かな。

Sub test2()
　　Dim rngLoop　　 As Range
　　Dim lngCnt　　　As Long
　　Dim strPre　　　As String
　　Dim rngResult　 As Range
　　Dim i　　　　　 As Long

　　'初期値設定
　　lngCnt = 0
　　strPre = ""
　　i = 1
　　'結果出力範囲設定
　　Set rngResult = Range("R110:AC150")
　　rngResult.ClearContents

　　For Each rngLoop In Range("R5:AC107")
　　　　'1つ前のセルと同値ならカウンタをカウントアップ
　　　　If rngLoop.Value = strPre Then
　　　　　　lngCnt = lngCnt + 1

　　　　'値が変わったら出力
　　　　Else
　　　　　　If lngCnt <> 0 Then
　　　　　　　　rngResult.Cells(i).Value = lngCnt
　　　　　　　　i = i + 1
　　　　　　End If
　　　　　　lngCnt = 1
　　　　　　strPre = rngLoop.Value
　　　　End If
　　Next rngLoop
　　'最終データの書き込み
　　rngResult.Cells(i).Value = lngCnt
　　
　　'オブジェクト開放
　　Set rngResult = Nothing
End Sub
【12145】Re:種類分けされたセル個数を順に表記す...
お礼  たけやん  - 04/3/24(水) 22:56 -
引用なし
パスワード
   ▼Asaki さん：
>数えながら出力するほうが、簡単かな。
>
>Sub test2()
>　　Dim rngLoop　　 As Range
>　　Dim lngCnt　　　As Long
>　　Dim strPre　　　As String
>　　Dim rngResult　 As Range
>　　Dim i　　　　　 As Long
>
>　　'初期値設定
>　　lngCnt = 0
>　　strPre = ""
>　　i = 1
>　　'結果出力範囲設定
>　　Set rngResult = Range("R110:AC150")
>　　rngResult.ClearContents
>
>　　For Each rngLoop In Range("R5:AC107")
>　　　　'1つ前のセルと同値ならカウンタをカウントアップ
>　　　　If rngLoop.Value = strPre Then
>　　　　　　lngCnt = lngCnt + 1
>
>　　　　'値が変わったら出力
>　　　　Else
>　　　　　　If lngCnt <> 0 Then
>　　　　　　　　rngResult.Cells(i).Value = lngCnt
>　　　　　　　　i = i + 1
>　　　　　　End If
>　　　　　　lngCnt = 1
>　　　　　　strPre = rngLoop.Value
>　　　　End If
>　　Next rngLoop
>　　'最終データの書き込み
>　　rngResult.Cells(i).Value = lngCnt
>　　
>　　'オブジェクト開放
>　　Set rngResult = Nothing
>End Sub

返事遅れて申し訳有りません。
まさに作成頂いた物が欲しかったのです。
非常に助かりました。
本当にありがとうございました。
神様仏様Asaki様！！！
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
12139 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free