人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

Excel VBAでツリー構造を作る方法を教えてください。
classを使ったサンプルソースのあるサイトなどがあれば嬉しいです。
幅優先経路探索を実装しようと思って「VBで木構造はどう書くかな?」でとまりました。
http://ja.wikipedia.org/wiki/%E5%B9%85%E5%84%AA%E5%85%88%E6%8E%A2%E7%B4%A2
こっちで公開したExcelマクロに効率的に状態遷移テストをするための経路探索を追加しようと思っています。
http://ruby.g.hatena.ne.jp/garyo/20080625/1214345304

●質問者: garyo
●カテゴリ:コンピュータ 科学・統計資料
✍キーワード:Class Excel VB VBA サイト
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● airplant
●60ポイント

VBAで無理やり書いてみました。ふうっ・・・

やっぱり、木構造など美し系のことは、CやJavaですね。

dev_zer0さんの物をそのままvbaに翻訳。動作しました。

'標準モジュール(Module1など)に入れる
Option Explicit

Public Sub main()
' B-Treeになるように自力で構築
 Dim root As clsTree
 
 Set root = New clsTree
 root.init ("4")
 root.add ("2") ' 4
 root.add ("6") ' / \
 root.add ("1") ' 2 6
 root.add ("3") ' / \ / \
 root.add ("5") ' 1 3 5 7
 root.add ("7") '
 
 root.debugP

  ' lookup test
 If (root.lookup("1")) Then Debug.Print ("OK:1")
 If (root.lookup("2")) Then Debug.Print ("OK:2")
 If (root.lookup("3")) Then Debug.Print ("OK:3")
 If (root.lookup("4")) Then Debug.Print ("OK:4")
 If (root.lookup("5")) Then Debug.Print ("OK:5")
 If (root.lookup("6")) Then Debug.Print ("OK:6")
 If (root.lookup("7")) Then Debug.Print ("OK:7")

 If (Not root.lookup("0")) Then Debug.Print ("OK:0")
 If (Not root.lookup("8")) Then Debug.Print ("OK:8")

End Sub
'クラスモジュール clsTree に入れる(名前固定)
Option Explicit

Private left As clsTree
Private right As clsTree
Private data As String

Public Sub init(s As String)
 Set left = Nothing
 Set right = Nothing
 data = s
End Sub

Public Function add(s As String) As Boolean
 Dim cmp As Integer
 cmp = StrComp(s, data)
 If (cmp < 0) Then
 If left Is Nothing Then
 Set left = New clsTree
 left.init (s)
 add = True
 Exit Function
 End If
 left.add (s)
 ElseIf (cmp > 0) Then
 If right Is Nothing Then
 Set right = New clsTree
 right.init (s)
 add = True
 Exit Function
 End If
 right.add (s)
 Else
  ' 同じ文字列は追加せずにfalseを返す仕様
 add = False
 End If
End Function

Public Property Get lookup(s As String) As Boolean
 Dim cmp As Integer
 cmp = StrComp(s, data)

 If (cmp < 0) Then
 If left Is Nothing Then
 lookup = False
 Exit Property
 End If
 lookup = left.lookup(s)
 Exit Property
 ElseIf (cmp > 0) Then
 If right Is Nothing Then
 lookup = False
 Exit Property
 End If
 lookup = right.lookup(s)
 Exit Property
 Else
 lookup = True ' 見つかった
 End If
End Property

Public Sub debugP()
 If Not left Is Nothing Then
 left.debugP
 End If
 Debug.Print ("data[" & data & "]")
 If Not right Is Nothing Then
 right.debugP
 End If
End Sub

Public Property Get getData() As String
 getData = data
End Property

気が狂う寸前です。なんで、!がNotでc++がc = c + 1なんだぁ!

おまけにsetがいるし・・笑

http://msdn.microsoft.com/ja-jp/library/s1k0fb7b.aspx

◎質問者からの返答

ありがとうございます。

VBAもclassが使えるので木構造ができるはずと思いましたが、普段つかったことがありませんでした。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ