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

回答の条件
  • URL必須
  • 1人5回まで
  • 登録:2008/06/25 07:55:52
  • 終了:2008/07/02 08:00:02

回答(1件)

id:airplant No.1

airplant回答回数220ベストアンサー獲得回数492008/06/27 03:07:21

ポイント60pt

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

id:garyo

ありがとうございます。

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

2008/06/27 07:17:36
  • id:taknt
    エクセルでツリー構造を表現すると

    A B C
    A B D
    A F G
    A F E D

    って こんな感じになると思います。
    ま、上の同じ文字なら 表示しない とすれば よりツリー構造の図に近くなると思いますけど。

    A B C
    _ _ D
    _ F G
    _ _ E D

    こんな感じで。


  • id:dev_zer0
    Javaで作ってはみたがVBAでは気が狂いそうになったので止めた
    # せめてVB.NETでないと俺には無理
    >>
    public class Tree {
    private Tree left;
    private Tree right;
    private String data;

    public Tree(String s) {
    left = right = null;
    data = s;
    }

    public static void main(String args[]) {
    // B-Treeになるように自力で構築
    Tree root = new Tree("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.debug();

    // lookup test
    if (root.lookup("1")) System.out.println("OK:1");
    if (root.lookup("2")) System.out.println("OK:2");
    if (root.lookup("3")) System.out.println("OK:3");
    if (root.lookup("4")) System.out.println("OK:4");
    if (root.lookup("5")) System.out.println("OK:5");
    if (root.lookup("6")) System.out.println("OK:6");
    if (root.lookup("7")) System.out.println("OK:7");

    if (!root.lookup("0")) System.out.println("OK:0");
    if (!root.lookup("8")) System.out.println("OK:8");
    }

    public boolean add(String s) {
    int cmp = s.compareTo(data);
    if (cmp < 0) {
    if (left == null) {
    left = new Tree(s);
    return true;
    }
    left.add(s);
    } else if (cmp > 0) {
    if(right == null) {
    right = new Tree(s);
    return true;
    }
    right.add(s);
    }
    // 同じ文字列は追加せずにfalseを返す仕様
    return false;
    }

    public boolean lookup(String s) {
    int cmp = s.compareTo(data);
    if (cmp < 0) {
    if (left == null)
    return false;
    return left.lookup(s);
    } else if (cmp > 0) {
    if (right == null)
    return false;
    return right.lookup(s);
    }
    return true; // 見つかった
    }

    public void debug() {
    if (left != null)
    left.debug();
    System.out.println("data[" + data + "]");
    if (right != null)
    right.debug();
    }

    public String getData() {
    return data;
    }
    }
    <<
  • id:garyo
    takntさん、どうも。
    プログラム内で使いたいのです。

    dev_zer0さん、ソースありがとうございます。
    >Javaで作ってはみたがVBAでは気が狂いそうになったので止めた
    ># せめてVB.NETでないと俺には無理
    同意ですね。久々にVBA使って、rubyの楽さが良くわかりました。

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません