| |
こんばんは。
>もう少しわかりやすいコードにならないかと言われてしまいまして、困ってます。
>(ハッシュとかがわからないみたいです。)
Dictionaryをハッシュと呼ぶのは私は抵抗がありますが・・・。
まあそれはさておき、
これの仕組みは簡単ですよね！！
私は、このサイトの投稿でしか使ったことがありませんが、
そもそもプロパティやメソッドも少ないし・・・。
わかりやすいオブジェクトです。
わからなかったら覚えなさい！！
というのが本当は結論のような気がしますけどねえ
これをDictionaryを使わないでとなると・・・。
Dictionaryと同じような処理コードを書かなくてはなりませんよね！！
このデータってアルファベットだけなんですか？
「漢字」とか「カタカナ」とか「ひらがな」はないのですか？
これと同じ処理にしようとすると、Match関数が使えないですね？
（Match比較がテキスト比較だから・・・）
標準モジュールに
'==================================================================
Sub main()
Dim w As Worksheet, nw As Worksheet
Dim i As Integer
Call open_tbl(Worksheets.Count + 1)
For i = 1 To Worksheets.Count
With Worksheets(i)
For Each crng In .Range("a1", .Cells(.Rows.Count, "a").End(xlUp))
Call put_tbl(crng.Value, i + 1, "○")
Next
End With
Next i
Set nw = Worksheets.Add(After:=Worksheets(Worksheets.Count))
With nw
.Name = "結果整理"
.Range("a1", .Cells(get_tblcnt, Worksheets.Count)).Value = Application.Transpose(get_tbl())
End With
Call close_tbl
End Sub
別の標準モジュールに
'Dictionaryオブジェクトの代わりのコード
'=================================================================
Private myarray() As Variant
Private colnum As Long
Private fptr As Long
'=================================================================
sub open_tbl(列数 As Long)
'テーブルｉ／ｏを初期化する IN：テーブル列の数（キー列も含む)
ReDim myarray(1 To 列数, 1 To 1)
colnum = 列数
fptr = 1
End sub
'=================================================================
Sub close_tbl()
'テーブルｉ／ｏの終了処理
Erase myarray()
colnum = 0
fptr=0
End Sub
'=================================================================
Sub put_tbl(key As Variant, colidx As Long, myvalue As Variant)
'テーブルにデータをセットする
' in key 検索キーデータ colidx--myvalueをセットする列数 myvalue--セットするデータ
Dim idx As Long
Dim f_flg As Long '0:keyで検索の結果見つからない 1:見つかった
f_flg = 0
For idx = 1 To fptr - 1
If myarray(1, idx) = key Then
GoSub put_proc
f_flg = 1
Exit For
End If
Next idx
If f_flg = 0 Then
ReDim Preserve myarray(1 To colnum, 1 To fptr)
idx = fptr
myarray(1, idx) = key
fptr = fptr + 1
GoSub put_proc
End If
Exit Sub
put_proc: 'in--idx colidx myvalue out:myarray()
myarray(colidx, idx) = myvalue
Return
End Sub
'=================================================================
Function get_tbl() As Variant
'テーブルを取得する
get_tbl = myarray()
End Function
'=================================================================
Function get_tblcnt() As Long
'テーブル要素数を取得する
get_tblcnt = UBound(myarray(), 2)
End Function
でmainを実行してみてください。
Dictionaryの有用性を解いたほうがよいと思いますが・・・。
|
|
ichinose
- 06/7/13(木) 20:53 -
