次のExcelのVBAプログラムはどう書けば良いでしょうか？

お助けくだされば大変有難いです。
次のExcelのVBAプログラムはどう書けば良いでしょうか？

注意：「Dim myDic As Object」「Set myDic = CreateObject("Scripting.Dictionary")」などのObject関数？は使わない

下に表すようにA列に1行目から順にA1111などのコードが入力されている。
次の番号や個数、何個目を得るプログラムを考察したい。

コードがA1111となる最初の行番号、最後の行番号、コードがA1111の個数
コードがB1234となる最初の行番号、最後の行番号、コードがB1234の個数、
さらにコードB1234はA1111を1個目のコードとする場合、何個目のコードか
コードがC1111となる最初の行番号、最後の行番号、コードがC1111の個数
さらにコードC1111はA1111を1個目のコードとする場合、何個目のコードか
コードがD1234、、、、、

仮に、
同コードの最初の行番号 FrontRownumber
同コードの最後の行番号 RearRownumber
同コードの個数 Codecount
そのコードが上から数えて何個目かを表す数 count
と変数定義するとして教えてください。


A列
1 A1111
2 A1111
3 A1111
4 B1234
5 B1234
6 B1234
7 B1234
8 B1234
9 B1234
10 C1111
11 C1111
12 C1111
13 C1111
14 C1111
15 C1111
16 C1111
17 C1111
18 C1111
19 C1111
20 D1234
21 D1234
、、、、

No.5 回答者： 30246kiku 回答日時： 2018/03/13 10:01

ベストアンサーは、何の指標にもならないかと？

順次、抜けなく比較するのなら Find は要らない･･･と思いませんか？

Find を使うのなら、
Find で見つかった次の行を、次の処理先頭にするとか･･･
中間の比較処理をしないように組むのではないでしょうか？


Public Sub Samp3()
　　Dim r As Range
　　Dim i As Long, n As Long

　　n = 0
　　i = 1
　　While (Cells(i, "A").Value <> "")
　　　　n = n + 1
　　　　Set r = Columns("A").Find(Cells(i, "A") _
　　　　　　, LookAt:=xlWhole, SearchDirection:=xlPrevious)
　　　　Debug.Print Cells(i, "A").Value
　　　　Debug.Print i
　　　　Debug.Print r.Row
　　　　Debug.Print r.Row - i + 1
　　　　Debug.Print n
　　　　i = r.Row + 1
　　Wend
End Sub

No.4 回答者： めぐみん_ 回答日時： 2018/03/12 21:01

No.2です

使わない事が条件であるのですし、使わなくても解決するのであれば使う必要もないのでは？
あちらのVBSのカテマスさんなんかは、使わずにいくつもの回答をされてベストアンサーに何度も選ばれてる位ですし

No.3 回答者： fujillin 回答日時： 2018/03/12 13:28

こんにちは

Dictionaryは種類を数えるときなどに便利ですが、使ってはいけないという条件は、同様のものを自前で実装しなさいという意図なのでしょうか？


回答はすでに出ているようですが、エクセルVBAとのことなので、エクセルらしくエクセルの計算機能を利用する案を…
多くのシート関数がVBAからも利用可能（WorksheetFunction）ですので、これを利用することで、比較的容易に計算できると思います。（Dictionary部分だけはちょっと工夫が必要ですが）


◇コードの個数
CountIfを利用して、
WorksheetFunction.CountIf(Columns(1), 対象コード)　で求められます。
Columns(1)としましたが、実際には範囲を限定しておいた方が良いでしょう（以下の他の計算でも同様です）

◇コードの最初の行番号
個数＞0の場合に、（0だとエラーになる）
Columns(1).Find(What:=対象コード, LookAt:=xlWhole).Row　で求められます

◇コードの最後の行番号
上記同様に逆順で求めればよいので
Columns(1).Find(What:=対象コード, LookAt:=xlWhole, SearchDirection:=xlPrevious).Row

◇何個目かを表す数
シートの空き列を利用しても良ければ、最初に出現する行までに
=IF(COUNTIF(A$1:A1,A1)=1,1,0)
という関数式を設定して、合計を（SUM関数）取得したら、設定した関数式を削除すればよいです

あるいは、列ではなくどこかの空きセルに
関数式　{=SUM(IF(COUNTIF(OFFSET(A$1,0,0,ROW(範囲)),範囲)=1,1,0))}
を設定し、値を取得することでも可能です。
（配列数式なので、式の設定は、Range.FormulaArray で設定します）

シートに記入するのは不可だというのであれば、最初のIF利用の計算値をワークシート関数で求めながら、ループして加算するようにすれば求められますので、出題（？）の条件に合った方法を採用すればよいでしょう

この回答へのお礼

有難うございます、非常に参考になりました。

お礼日時：2018/03/12 20:51

No.2 回答者： めぐみん_ 回答日時： 2018/03/10 05:39

既に納得のいく回答は得られたのではないでしょうか？

https://detail.chiebukuro.yahoo.co.jp/qa/questio …

この回答へのお礼

次の回答を得られましたが、Objectの考え方がわかりませんでした。
自分で勉強すべきですね。

Sub try()
Dim myDic As Object
Dim r As Range
Dim FrontRownumber As Long, RearRownumber As Long
Dim Codecount As Long, Count As Long, i As Long
Dim v As Variant, Key As Variant

Set myDic = CreateObject("Scripting.Dictionary")

Count = 0

For Each r In Range("A1", Cells(Rows.Count, 1).End(xlUp))

If Not myDic.Exists(r.Value) Then
Count = Count + 1
myDic.Add r.Value, Array(r.Row, r.Row, 1, Count)
Else
v = myDic(r.Value)
v(1) = r.Row: v(2) = v(2) + 1
myDic(r.Value) = v
End If

Next

Range("C1:G1").Value = Array("コード名", "最初の行番号", "最後の行番号", "コードの個数", "コード種No")
i = 2

For Each Key In myDic.Keys

FrontRownumber = myDic(Key)(0)
RearRownumber = myDic(Key)(1)
Codecount = myDic(Key)(2)
Count = myDic(Key)(3)

Range("C" & i).Resize(, 5).Value = Array(Key, FrontRownumber, RearRownumber, Codecount, Count)
i = i + 1
Next

Set myDic = Nothing
End Sub

お礼日時：2018/03/12 20:49

No.1 回答者： WindFaller 回答日時： 2018/03/09 21:27

こんばんは。

>注意：「Dim myDic As Object」「Set myDic = CreateObject("Scripting.Dictionary")」などのObject関数？は使わない

今のExcelというのは、こういうDictionary オブジェクトなどを制限すると、後々は、行き詰まってしまうとは思いますが、何かの宿題でしょうか。

私以外に、ご質問者さんの望む解答が付くとは思いますので、あえてイレギュラーな解答をさせていだきます。ふつうは、ループで、一つずつ前のものと同じかどうかの区分けをします。こんな書き方をする人もいるのだ、と思っていただいてかまいません。

'//
Sub CountSameValues()
　Dim r As Range
　Dim i As Long, j As Long, k As Long
　Dim Ar() As Variant
　'ダミーセルを加える
　Cells(Rows.Count, 1).End(xlUp).Offset(1).Value = "Dummy"
　Set r = Range("A1", Cells(Rows.Count, 1).End(xlUp))
　i = 1
　Do
　　 On Error Resume Next
　　 Set r = r.ColumnDifferences(Cells(i, 1))
　　 If Err.Number <> 0 Then Exit Do
　　 On Error GoTo 0
　　 j = r.Cells(1).Row　'上から数えて何行目
　　 ReDim Preserve Ar(2, k)
　　 Ar(0, k) = i
　　 Ar(1, k) = j - 1
　　 Ar(2, k) = j - i
　　 k = k + 1
　　 i = j
　Loop
　Cells(Rows.Count, 1).End(xlUp).ClearContents　'ダミーの削除
　'C1から出力
　Range("C1").Resize(, 3) = Array("開始行", "終了行", "個数")
　Range("C2").Resize(k, 3) = Application.Transpose(Ar())
End Sub

この回答へのお礼

有難うございます。

すみません、私の得たい数字は次の数字ですが、
(コード名　CodeName)
同コードの最初の行番号 FrontRownumber
同コードの最後の行番号 RearRownumber
同コードの個数 Codecount
そのコードが上から数えて何個目かを表す数 count

ご回答の　Array("開始行", "終了行", "個数")
Ar(0)=
Ar(1)=
Ar(2)=
文のあたりで得られているということでしょうか？

お礼日時：2018/03/09 22:25