[[20090627150504]]　『西暦～和暦の変換　あるいは系譜図の作成　改題』（はんにゃ）　ページの最後に飛ぶ

『西暦～和暦の変換　あるいは系譜図の作成　改題』（はんにゃ）

 今Sheet1 B列に西暦あるいは和暦何れかのデータ(順不同）があります。
 Sheet2 A列に和暦年号、B列に和暦年　さらにC列に西暦を順に記載したい。

 江戸後期よりデータがありうる。
 年としての形式は１900以前は受け付けないので
 データの年は初めから　単なるKyy.mm.dd あるいはyyyy.mm.dd の文字列に
 入力した方が良いでしょう。

 データをどのように変換して記載するでしょうか？

 Sheet1
  A    B　'元年＝１年目
 氏名  生年
 誰々　寛永2.2.2
 dare  1751.3.3 
 sheet2
 A       B       C
 寛	元年	1748
 延	2	1749
	3	1750
 宝	元年	1751
 暦
　略

 なお、マクロで　近年の制約では　はなさんの助言で以下の使っています。（ありがとうございます）。その制約を広げたい。

 With Sheets("Sheet1")
  tbl1 = .Range("A1").Resize(.Range("A" & Rows.Count).End(xlUp).Row + 1, 5) 'D列没年挿入
   nn = Year(Application.Min(.Range("B:B"))) - 1 'nn = Sheet1の誕生日の最古年の前年
 End With 
 ReDim y(1 To Year(Date) - nn + 1, 1 To 3)   '現在まで
        y(1, 3) = nn
        y(1, 2) = Format(y(1, 3) & "/1/1", "e")
        y(1, 1) = Format(y(1, 3) & "/1/1", "ggg")
 For i = 2 To UBound(y, 1)
        y(i, 3) = y(i - 1, 3) + 1
        y(i, 2) = Format(y(i, 3) & "/1/1", "e")
    If y(i, 2) < y(i - 1, 2) Or y(i, 2) Mod 10 = 0 Then
        y(i, 1) = Format(y(i, 3) & "/1/1", "ggg")
    End If
 Next
 With Sheets("Sheet2")
 略
    .Cells.ClearContents
    .Range("A1").Resize(UBound(y, 1), 3) = y
    .Range("D1").Resize(UBound(y, 1), xc + 3) = x
    ' C列に西暦を入れるためC1→D1に
    .Range("C1").Resize(UBound(y, 1), 1).Copy .Range("D1").Cells(1, xc + 5)
 End With

よろしく　

 （はんにゃ）

 こんにちは。かみちゃん　です。

 > 江戸後期よりデータがありうる。
 > 年としての形式は１900以前は受け付けないので

 他の掲示板で恐縮ですが、昔、以下のようなスレッドでコメントさせていただいたことがあります。
http://park7.wakwak.com/~efc21/cgi-bin/exqalounge.cgi?print+200608/06080150.txt

 発想の転換が必要かもしれませんが、何かの参考になればと思います。

 (かみちゃん)
 2009-06-27 16:45

 なかなか難しいことだとわかりました。
 参考にして　コードに追加してみたいと思います。
 実際に　多くの入力は元号で　それを年表系譜で西暦にして描くということになるでしょう

 　＊日本神話の年数まで該当する人がいるとは驚きです。神話の中で出てくるのでしょうか？
 小生には現世　近世の系譜ですから　すこしそれより少なくなるようです。

以下のように　西暦和暦混合は難しそうなのでわけました。

 　1氏名　2生年西暦 3元号　4和暦　5没年西暦　6元号　7和暦
 湘南始		　　明治 16.12.22　　　　　昭和　35.10.10
 [藤沢]乙女　1960.10.9		1950.2.2
 湘南藍子   ?                      ?
 以後略

 注　年数の既知の場合　西暦か和暦何れかを手入力する。
 生年、没年不明の場合　？と西暦欄に記す。
 日付と一緒なデータの、このような表現は文字列になるでしょうか？
 和暦の3元号と4和暦と一緒の記述でも可です。別途にした処理がしやすいかと仮にしました。

 結果は　？を除いて、西暦、和暦を換算し、空欄に記入することを期待します。
 年数の在り得る最古は999 長保元年とします。

 Excelには関数とか　VBでのコードとか　Functionとかいろいろあるようですが
 どれをつかったらよいでしょうか？
 どのようなコードでしょうか？　ご教授おねがいします。
 (はんにゃ

 ↓前スレ　より、変換を名目に引っ越して来ました。
[[20090619072025]]『改題２　Sheet1の氏名、生年、没年 等身関係等をSheet２の年軸表に記載』（はんにゃ）

 まず、和暦→西暦　と　西暦→和暦　の対応表が必要です。
 「対応表」というシートに
 A,B列を使用して　和暦→西暦　の表
 　A列に、和暦
 　B列に、元年が対応する西暦
 を入力して下さい。

 年に依っては、和暦が二つ有る場合が有りますが
 Sheet1にどちらで入力されるか決まっていない場合は
 両方記述して下さい。

 C列を一列空けて、D,E列に　西暦→和暦　の表
 　D列に、西暦
 　E列に、和暦
 を入力して下さい。

 こちらの表は、D列が昇順に成っている必要が有ります。
 また、和暦は表示させたい方の年号を書いてもらえば良いですが
 元年の和暦と対応している　と言うルールですので、例えば
1384 元中1/至徳1 
1385 元中2/至徳2 
1386 元中3/至徳3 
1387 元中4/嘉慶1 
1388 元中5/嘉慶2 
1389 元中6/康応1 
1390 元中7/明徳1 
1391 元中8/明徳2 
1392 元中9/明徳3 
1393 明徳4 
 この部分は、注意が必要です。
 （元中は、10年が有りませんし、1393年は明徳4年ですから。）

 Sheet1への入力は
 　A列　氏名
 　B列　生・年号
 　C列　生・年月日
 　D列　没・年号
 　E列　没・年月日
 　F列　性別
 　G列　関係
 の順で入力して下さい。

 入力の具体例は以下の様に成ります。
	[B]	[C]
[1]	生年号	生年月日
[2]		1930.10.9
[3]	昭和	16.12.22
[4]	昭和	？
 年号だけ入力が有る場合は、元年の年として扱います。

 享年は、没年－生年＋１　で計算しますので
 実際の年齢とは一致しない場合が有ります。

 '------
Sub nenpyokeifu_8()
    Dim tbl1, totbl, x, y
    Dim nr As Range, sr As Range
    Dim xc As Long, xr As Long, nn As Long
    Dim i As Long, ii As Long
    Dim fyi As Long, cyi As Long, mcy As Long
    Dim p1(6), p2(6)
    Dim sb As String

    With Sheets("データ表")
        tbl1 = .Range("A1").Resize(.Range("A" & Rows.Count).End(xlUp).Row + 1, 12)
    End With

    With Sheets("年号対応表")
        totbl = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp)).Resize(, 2)
        Set nr = .Range(.Range("E2"), .Range("E" & Rows.Count).End(xlUp))
        Set sr = .Range(.Range("D2"), .Range("D" & Rows.Count).End(xlUp))
    End With

    Call snsr(tbl1, nn, totbl)
    If nn <= 999 Then
        MsgBox "999年以前のデータが有ります。"
        Exit Sub
    End If

    ReDim y(1 To Year(Date) - nn, 1 To 3)
    Call np(y, nn, nr, sr)

    ReDim x(1 To UBound(y, 1), 1 To Columns.Count)
    xc = 2 '作図の左端D列から
    For i = 2 To UBound(tbl1, 1)
        If tbl1(i, 1) = "" Then
            If tbl1(i - 1, 1) <> "" Then
                fyi = psn(nn, p1(2), p2(2))
                xr = fyi - nn + 1
                x(xr, xc) = p1(0) & knm(p1(3), p1(1)) & "===" & p2(0) & knm(p2(3), p2(1))
                x(xr + 1, xc + 1) = sngpse(p1(2), p1(3), p1(4), p1(5), p1(6))
                x(xr + 2, xc + 3) = sngpse(p2(2), p2(3), p2(4), p2(5), p2(6))
            '親の系譜線
                If fyi > nn Then
                    x(xr - 1, xc) = "｜"
                End If
                    x(xr + 1, xc) = "｜"
                    x(xr + 2, xc) = "｜"
            '子の系譜線
                If xr < mcy Then
                    For ii = xr + 2 To mcy + 1
                        If x(ii, xc + 2) = "" Then
                            x(ii, xc + 2) = "｜"
                        End If
                    Next
                End If
                xc = xc + 5  ' コメント　この追加数字が系譜幅
                fyi = 0: cyi = 0
                Erase p1: Erase p2
                mcy = 0
            End If
        Else
            If tbl1(i, 6) Like "*[父,夫]*" Then
                sb = "△"
                Call pd(tbl1, i, sb, p1, p2)
            ElseIf tbl1(i, 6) Like "*[母,妻]*" Then
                sb = "▼"
                Call pd(tbl1, i, sb, p1, p2)
            Else
                If tbl1(i, 8) = "" Or tbl1(i, 8) = "？" Or tbl1(i, 8) = "?" Then
                        MsgBox "誕生日が未入力です。" & vbLf & tbl1(i, 1)
                Else
                    cyi = tbl1(i, 8)
                    xr = cyi - nn + 1
                    If tbl1(i, 6) Like "*[息子]*" Then
                        sb = "△"
                    ElseIf tbl1(i, 6) Like "*[娘]*" Then
                        sb = "▼"
                    Else    '関係が無記載
                        sb = "◎"
                    End If
                    If x(xr, xc + 3) <> "" And x(xr - 2, xc + 3) = "" Then
                        x(xr - 2, xc + 3) = x(xr, xc + 3)
                        x(xr, xc + 3) = ""
                    End If
                    If x(xr, xc + 3) <> "" And x(xr - 2, xc + 3) = "" Then
                        x(xr - 2, xc + 3) = x(xr, xc + 3)
                        x(xr, xc + 3) = ""
                    End If
                    x(xr, xc + 2) = sb & knm(tbl1(i, 9), tbl1(i, 1))
                    x(xr + 1, xc + 3) = sngpse(tbl1(i, 8), tbl1(i, 9), tbl1(i, 10), tbl1(i, 11), tbl1(i, 12))
                    mcy = Application.Max(xr, mcy)
                End If
            End If
        End If
    Next
With Sheets("系譜図")
    .Cells.ClearContents
    .Range("A1").Resize(UBound(y, 1), 3) = y
    .Range("D1").Resize(UBound(y, 1), xc + 3) = x
    ' C列に西暦を入れるためC1→D1に
    .Range("C1").Resize(UBound(y, 1), 1).Copy .Range("D1").Cells(1, xc + 5)
End With
Set nr = Nothing
Set sr = Nothing
End Sub
 '======
Private Function knm(bngp, nm)
    If nm = "" Then
        knm = "≪不明≫"
    Else
        If bngp <> 1 Then
            knm = "故_" & nm
        Else
            knm = nm
        End If
    End If
End Function
 '======
Private Function sngpse(ss, se, tngp, bngp, nr)
    If tngp = "" Then
        sngpse = "≪不明≫～"
    Else
        sngpse = tngp & "～"
    End If
    If bngp = "" Then
        sngpse = sngpse & ≪不明≫
    Else
        sngpse = sngpse & bngp
    End If
    If nr = Empty Then
        sngpse = sngpse & "享年" & se - ss + 1
    End If
End Function
 '======
Private Function psn(nn, fys, mys)
    If fys <> "" Then
        If fys = "?" Then
            psn = nn
        Else
            psn = fys
        End If
    Else
        If mys = "?" Or mys = "" Then
            psn = nn
        Else
            psn = mys
        End If
    End If
End Function
 '======
Private Sub pd(tbl1, i, sb, p1, p2)
    If p1(0) = Empty Then
        p1(0) = sb
        p1(1) = tbl1(i, 1)
        p1(2) = tbl1(i, 8)
        p1(3) = tbl1(i, 9)
        p1(4) = tbl1(i, 10)
        p1(5) = tbl1(i, 11)
        p1(6) = tbl1(i, 12)
    Else
        p2(0) = sb
        p2(1) = tbl1(i, 1)
        p2(2) = tbl1(i, 8)
        p2(3) = tbl1(i, 9)
        p2(4) = tbl1(i, 10)
        p2(5) = tbl1(i, 11)
        p2(6) = tbl1(i, 12)
    End If
End Sub
 '======
Private Sub np(y, nn, nr, sr)
Dim i As Long, ti As Long
            y(1, 3) = nn
            ti = Application.Match(y(1, 3), sr)
            y(1, 1) = Application.Index(nr, ti)
            y(1, 2) = nn - Application.Index(sr, ti) + 1
    For i = 2 To UBound(y, 1)
            y(i, 3) = y(i - 1, 3) + 1
            ti = Application.Match(y(i, 3), sr)
            y(i, 2) = y(i, 3) - Application.Index(sr, ti) + 1
        If y(i, 2) = 1 Or y(i, 2) Mod 10 = 0 Then
            y(i, 1) = Application.Index(nr, ti)
        End If
        If y(i - 1, 2) = 1 Then
            y(i - 1, 2) = "元年"
        End If
    Next
End Sub
 '======
Private Sub snsr(tbl1, nn, totbl)
    Dim dic As Object
    Dim i As Long, ii As Long
    Dim kn
Set dic = CreateObject("scripting.dictionary")
nn = Year(Date)
    For i = 1 To UBound(totbl, 1)
        dic(totbl(i, 1)) = totbl(i, 2)
    Next
    For i = 2 To UBound(tbl1, 1)
        For ii = 0 To 1
            tbl1(i, 2 + ii * 2) = Trim(tbl1(i, 2 + ii * 2))
            tbl1(i, 3 + ii * 2) = Trim(StrConv(tbl1(i, 3 + ii * 2), vbNarrow))
                kn = Split(tbl1(i, 3 + ii * 2) & ".", ".")(0)
            If tbl1(i, 2 + ii * 2) = "" Then
                tbl1(i, 8 + ii) = kn
                If kn = "?" Or kn = "" Then
                    tbl1(i, 8 + ii) = kn
                Else
                    tbl1(i, 8 + ii) = Replace(kn, "?", 0)
                End If
            Else
                If dic.exists(tbl1(i, 2 + ii * 2)) Then
                    If kn = "?" Or kn = "" Then
                        tbl1(i, 8 + ii) = dic(tbl1(i, 2 + ii * 2))
                    Else
                        tbl1(i, 8 + ii) = dic(tbl1(i, 2 + ii * 2)) + Val(Replace(kn, "?", 0)) - 1
                    End If
                Else
                    tbl1(i, 8 + ii) = kn
                End If
            End If
            If Val(tbl1(i, 8 + ii)) > 1 Then
                nn = Application.Min(nn, tbl1(i, 8 + ii))
            End If
            tbl1(i, 10 + ii) = tbl1(i, 2 + ii * 2) & tbl1(i, 3 + ii * 2)
            If tbl1(i, 2 + ii * 2) & kn Like "*[?]*" Or tbl1(i, 8 + ii) = "" Then
                tbl1(i, 12) = 1
            End If
        Next
    Next
nn = nn - 4
Set dic = Nothing
End Sub
 '------

 上手く動くと良いですね～。（笑）

 (HANA)
 　　nenpyokeifu_4 → nenpyokeifu_5 2009/7/4 19:49
 　　nenpyokeifu_5 → nenpyokeifu_6 2009/7/4 23:35
 　　nenpyokeifu_6 → nenpyokeifu_7 2009/7/6 22:40
 　　nenpyokeifu_7 → nenpyokeifu_8 2009/7/9  0:51

早速ありがとうございます

 対応表で A列B列は以下のように作成しました。
 虫の良い（横着）と叱られるやにおもったのですが、

D,E列は999から一年毎　

 999　長保１
 1000 長保２
と　現在までづっと書くのでしょうか？

西暦＝元号の元年＋和暦年―1　(そちらのコードがどこが該当か理解不足ですが多分）
のように、　
和暦＝西暦該当範囲の最小年（＝Y)の元号　と（西暦―Y＋１）
のように　AとB列で　Sheet2を得ることはできませんでせうか？
　

 A１和暦元号	B1元年対応西暦	C１時代	D1　西暦	E1和暦
     長保 	999	平安時代(794→)	999	   長保 
     寛弘 	1004		1004	    寛弘 
     長和 	1012		1012	    長和 
     寛仁 	1017		1017	    寛仁 
 途中略				
     慶応 	1865		1865	    慶応 
     明治 	1869	明治時代(1868→)	1869	    明治 
     大正 	1912	大正時代(1912→1926)	1912	    大正 
     昭和 	1926	昭和時代(1926→1989)	1926	    昭和 
     平成 	1989	平成時代(1989→)　	1989	    平成

よろしく　おねがいします

 えっと、基本的には下側に載せておられる様に
「元年」の物だけ書いてある対応表を
 作成しておいてもらえば良いですが？

 そして、一つ書き忘れていました。
 どちらも、1行目は見出し行にして
 2行目から表にして下さい。

 日本語が分かりにくいかも知れませんが
 ＞B列に、元年が対応する西暦
 ですから
 A2に　天保と入れて
 B2には　元年が対応する西暦　999　を入力。
 A3に　寛弘と入れて
 B3には　元年が対応する西暦　1004　を入力　です。

 和暦→西暦　と　西暦→和暦　の
 二つの表が必要なのは
 一つの西暦で和暦が二つある場合が有る為です。

 例えば、
 元中4.1.1と入力されたら 1387.1.1と見なし
 嘉慶1.1.1と入力されても 1387.1.1と見なす必要が有ります。

 ですから、和暦→西暦　の方の表には
 元中 1384（元年の年）と嘉慶 1387（元年の年）
 等、複数有る場合は　それぞれの和暦に対して
 対応する西暦が入力されている必要が有ります。

 しかし、西暦→和暦　の方は
 一つの西暦に対して一つの和暦でないと　処理が面倒ですし
 表示させるところも有りませんよね。

 1387年は、どちらを表示させたいのか　そちらで決めて下さい。
 例えば、元中4と表示させたいなら
 D,E列には　1384 元中　の方だけを書いて
 嘉慶の方は入力しない。

 嘉慶1と表示させたいなら、1387 嘉慶　の方を書いて
 元中は書かない。（まぁ、それまでは元中で良いってなら
 書いてもらっても良いですが・・・・。）

 その様に決めていくと、D,E列のデータ数は　A,B列の物よりも
 少なくなると思いますよ。

 意味が分かりますか？

 再度書いておきますが、元年が対応する西暦を書き
 なおかつ、D,E列は　西暦が昇順に成っていないと
 正しい結果が得られません。

 A列に表示させる時にどうせ言われても分からないから、
 和暦はおおよそ書いてあれば良いよ
 （本当は、元中10年は無い様ですが　その様に表示されても大した問題にしない）
 と言う事であれば、どちらの年号を使うか　と言う事に関しては
 そんなに気にしなくても良いのかもしれませんが。。。

 (HANA)

なるほど、わかりました。この二つの元号がある場合のデータ追加は追ってします。

 ありがとうございます。

で現在の状況は　生年ー没年には　和暦ー和暦、和暦ー西暦、西暦ー西暦、西暦ー和暦
の組み合わせがあり、
それによるためか　はっきりしないのですが　以下のような結果です。
もちろん　こんな組み合わせが自由過ぎるようであれば、同じ同型の暦年表示にしますが
できれば活かしたい。

 不都合な箇所を取り出しました（コピーがうまくいくかな？）。その内容は？の疑問です。

 sheet1

 湘南始	天保	12.22	慶応	2.10.19	M	太郎の父
 [藤沢]乙女	明治	19.9.1		1901.10.11	F	太郎の母
 藍子		1960.10.1	昭和	45.1.1	F	
 太郎		1961.10.1			　	始の子

 湘南太郎		1961.10.1			M	組の夫
 [米子]組		1947.3.1			F	太郎の妻

 湘南藍子		1960.10.1		1970.1.1	F	大山の妻
 [米子]大山		1950.5.3			M	発の父
 発		1966.10.2

 清水　富士	慶応 	2.3	明治	2.4.4	M	乙女の父
 ？		？	明治	3.2.1		乙女の妻
 　乙女		1870.1.2		1901.10.11	F	富士の子

 米子　？		？		1960.10.9	M	組の父
 [鳥]娘		1940.12.2			F	組の母
 　組		1947.3.1			F	
 大山		1950.5.3			M	娘の子

 sheet2

 慶応 	1	1865		△湘南始===▼故_[藤沢]乙女								
 	2	1866		｜	≪不明≫～　享年：1							
 	3	1867		｜		｜	≪不明≫～1901.10.11　享年：1902

 生年の読まない？

 	34	1959				｜	1960.10.1～　享年：-1959
 	35	1960				▼藍子

 没年を読まない？ 故が着かない？　子供のとき。没年をよまないか？

 ｜			
 △清水　富士===▼？			
 ｜	慶応 2.3～		
 ｜		｜	？　～

 没年を読まない？

 sheet1 
　乙女	明治	20.10.9		1901.10.11
 のとき , " 誕生日"が未入力です　となる？

 希望を言えば、
 1: 和暦入力は　元年も1.2.30のようにそろえたい。
 2: 元号１年は元年と表記したい。特にB列で。

ありがとうございます

sheet1の一行がコピーで　抜けていました。なお、書式は標準でも文字列でも同結果でした

 sheet1
 1A1氏名　　不明は？系譜間は一行空白　　　　　　　　 	2B1 生年　　和暦は元号、西暦は空白	3C１　生年.月.日　　　　　西・和暦共通、不明は？	4D1 没年　和暦は元号、西暦は空白	5E1没年.月.日　　　　　西・和暦共通、不明は？	6F1性　　　　　M.F.?.未記載	7G1父母/夫婦何れか　無記載は子と見なす　		使い方：　シート１に親子関係を系譜毎に記し、ALT＋F8,　then +Rを押し、次シート２で系譜を得る。氏と名の間を空けても可。各系譜間の婚姻作図は新系譜の名前セルをカットし、元の名前セルと置き換え、＝＝＝長を調整する。双子、養子等の記述法？結婚日、没年など系譜線上に没年×印と日時記載未完、Sheet2の書式は文字列とすると”＝＝＝”も入る。

 湘南始	天保	12.22	慶応	2.10.19	M	太郎の父
 [藤沢]乙女	明治	19.9.1		1901.10.11	F	太郎の母
 藍子		1960.10.1	昭和	45.1.1	F	
 太郎		1961.10.1			　	始の子

 湘南太郎		1961.10.1			M	組の夫
 [米子]組		1947.3.1			F	太郎の妻

 湘南藍子		1960.10.1		1970.1.1	F	大山の妻
 [米子]大山		1950.5.3			M	発の父
 発		1966.10.2

 清水　富士	慶応 	2.3	明治	2.4.4	M	乙女の父
 ？		？	明治	3.2.1		乙女の妻
 　乙女		1870.1.2		1901.10.11	F	富士の子

 米子　？		？		1960.10.9	M	組の父
 [鳥]娘		1940.12.2			F	組の母
 　組		1947.3.1			F	
 大山		1950.5.3			M	娘の子

 それと関係する対応表は以下のとおりです

 A１    和暦  元号	B1   元年 西暦	C１ 時代	D1　 西暦 　　元年	E1    和暦 元号
 文政 	1818		1818	文政 
 天保 	1830		1830	天保 
 弘化 	1844		1844	弘化 
 嘉永 	1848		1848	嘉永 
 安政 	1854		1854	安政 
 万延 	1860		1860	万延 
 文久 	1861		1861	文久 
 元治 	1864		1864	元治 
 慶応 	1865		1865	慶応 
 明治 	1869	明治時代(1868→)	1869	明治 
 大正 	1912	大正時代(1912→1926)	1912	大正 
 昭和 	1926	昭和時代(1926→1989)	1926	昭和 
 平成 	1989	平成時代(1989→)　	1989	平成

 南北朝の2重元号の場合　対応表を

 永徳 	1381		1381	永徳 	
 元中	1384		1384	元中1/至徳1	
 至徳 	1384		1385	元中2/至徳2	
 嘉慶 	1387		1386	元中3/至徳3	
 康応 	1389	室町時代(1392→1491)	1387	元中4/嘉慶1	
 明徳 	1390		1388	元中5/嘉慶2 	
 応永 	1394		1389	元中6/康応1	
 正長 	1428		1390	元中7/明徳1	
 長享 	1429		1391	元中8/明徳2	
 嘉吉 	1441		1392	元中9/明徳3	
 文安 	1444		1393	明徳4	
 宝徳 	1449		1394	応永

 としてよいでしょうか。
 その前に E列の和暦は永徳1、応永1のように１を入れておく必要があるでしょうか。
　このために　前のエラーがでるのかもしれないと　天保以後天保1としたが、それでも同じであった。

その前後の

 おかしいですね、こちらではその様には成りませんが。

 入力する列がずれていませんか？
 或いは、Sheet1の　B1 生年　に入れた文字と
 対応表のA列に入っている文字は
 完全に一致していますか？

 Sheet1のB,D列に直接入力するのではなく
 対応表のA列の該当セルから
 コピーして貼り付けてみるとどうでしょう？

 なお、C,E列は　年.月.日　と３つ揃えて入力するか
 「？」或いは　未入力にして下さい。
 　　但し、子の場合は入力が必要です。

 元年の場合は、1　とあらわして入力して下さい。
 例えば、平成元年12月31日生まれの場合は
 　B列に　平成
 　C列に　1.12.31
 と入力します。

 ＞南北朝の2重元号の場合　対応表を
 ＞・・・（中略）・・・
 ＞としてよいでしょうか。
 出来ません。

 ＞E列の和暦は永徳1、応永1のように１を入れておく必要があるでしょうか。
 A,B列も、D,E列も　入力するデータは
 「元年が対応する西暦」で有ることは変わりません。

 そして、A列に入力しているように
 永徳　応永　と、年号だけを入力して下さい。

 つまり、西暦→和暦の対応表は
 A,B列に入力したデータの内
 　年が重ならないように、且つ　元年のデータのみ
 を選んで作成してください。

 1393年は明徳4年と成っていますが、D,E列に
 1393　明徳　と書くと、1393年が明徳元年であると見なしますので
 気を付けて下さい。

 (HANA)

 忘れていました。

 ＞2: 元号１年は元年と表記したい。特にB列で。
 Sheet2のB列はその様に変更しました。
 また、同じ部分内で問題が見つかりましたので
 そちらも修正しました。

 変更したのは「Private Sub np(y, nn, nr, sr)」の部分だけですが
 マクロ名を新たに（5）しましたので
 もう一度貼り付け直して頂ければと思います。

 (HANA) 2009/7/4 19:49

たいへんありがとうございました
不注意でした（実はコピーで、元号数字などの分離スペース削除が不良でした）。

元号の後ろに半角スペースがあったのをひとつひとつ除きました。
正しく　読めて　表記されました。

 対応表のD,E列がまだ理解できていないです。
1381	永徳	
1384	元中/至徳	
1385	元中2/至徳2	
1386	元中3/至徳3	
1387	元中4/嘉慶1	
1388	元中5/嘉慶2	
1389	元中6/康応1	
1390	元中7/明徳1	
1394	応永	
西暦ー和暦対応では　元中か、別元号か何れかを選択しないといけないということでしょうか？
もし　そうなら（南北どちらがどうか考えずに）　変化の少ない元中を選びます。

マクロ（５）が記載されていないのですが　

 ＞西暦ー和暦対応では　元中か、別元号か何れかを選択しないといけないということでしょうか？
 そうです。

 「1387年は、どちらを表示させたいのか　そちらで決めて下さい。
 　例えば、元中4と表示させたいなら
 　D,E列には　1384 元中　の方だけを書いて
 　嘉慶の方は入力しない
 　嘉慶1と表示させたいなら、1387 嘉慶　の方を書いて
 　元中は書かない。」
 です。

 ＞もし　そうなら（南北どちらがどうか考えずに）　変化の少ない元中を選びます。
 でしたら、
 　　1381 永徳
 　　1384 元中
 　　1394 応永
 と入れて下さい。

 ただし、この様にすると Sheet2には　実際には無い　元中10　が表示されます。

 いくつか年号が重複する期間がある中で　私がこの部分を引用したのは
 この「元中10」が問題になりそうに思った為です。

 先に書いた部分ですが
 「A列に表示させる時にどうせ言われても分からないから、
 　和暦はおおよそ書いてあれば良いよ
 　（本当は、元中10年は無い様ですが　その様に表示されても大した問題にしない）
 　と言う事であれば、どちらの年号を使うか　と言う事に関しては
 　そんなに気にしなくても良いのかもしれませんが。。。」
 この部分のことですが・・・改めて読むと意味が通じますか？
　
　
　
 ＞1: 和暦入力は　元年も1.2.30のようにそろえたい。
 これは「年号だけ入力が有る場合は、元年の年として扱います。」
 を読んでのことだったのですね。

 ここは、そういった意味（1年の場合は省略して　月日のみ入力する）ではなく
 たとえば、1000年生まれの人が居たとしますね。
 そして、昭和生まれの人が居たとしますね。
 昭和生まれの人は、昭和生まれである事だけが分かっていて
 何年の何月だったのかまでは　わからなかったとします。

 生年月日部分を　？　としてしまうと、生年月日不明で一行目に表示されてしまいますね。
 本当は、もっと下（900行程度下）に配置されれば良いのに。。。

 そういった場合は、生年号に「昭和」と入れて
 年月日を「？」あるいは未入力にしておくと
 昭和元年に生まれたとして扱います。
 （子でなく、連れ合いより上に入力されていたら、
 　昭和元年に二人の名前を並べる）

 という意味でした。

 のですが。。。分かりますか。。。？

 ちなみに、年月日の方は　「.」で分けた最初の区切りを
 年として扱います。

 たとえば、天保　12.22　は、天保12年　と考えます。

 ＞マクロ（５）が記載されていないのですが　
 コードが長いので、上のコードを直接変更して
 コード名も変更しました。

 生年月日がそろっているかの確認に　LEN()>=7 を使っていましたが
 問題がある様なので、この部分の修正をしたものを
 nenpyokeifu_6として、上に載せておきます。

 そして、今頃気づいたのですが、999年生まれの人が入力された場合
 Sheet2の1行目は998年になりますので　対応する年号が
 必要になります。
 そこで、対応表の2行目(D,E列)は　995 長徳　から始めて下さい。

 (HANA) 2009/7/4 23:35

ありがとうございました。改修版が元の修正で置いてあることを知りました。
早速　直して働きました。

 1392	元中9/明徳3	
 1393	明徳4

 やっとわかりました。元中は9年でおわって、明徳４年単独になったので、そこだけ
2重でなくなった。それでは　至徳　嘉慶らの方を記載します。

 年号のみ記載のこともわかりました。
 これでは　実際のデータをいれて　作図し、手で統合してみようと思います。

ありがとうございました

 子供系線は　その両親が無くなれば　伸びないので最後の没年まで、片親が居れば現在まで描き、X印をつけることをしてみようと思います。
 コードを追加してみようとがんばってみます。壊さないようにコピーと取ってやります。
　倒れ、自力で立ち上がれないときにはまた援助をおねがいします。
では　ありがとうございました。

入力をするときに楽をするために　性別欄を空欄にして　関係欄に　夫/妻　あるいは　息子/娘　無記載（子とみなす）　と書くようにしました。（今頃考えて　すみません）

そしてコードをかえました。

                    cyi = tbl1(i, 8)
                    xr = cyi - nn + 1
                    　　'If tbl1(i, 6) = "M" Then
                    If tbl1(i, 7) Like "*[息子]*" Then
                        sb = "△"
                    ElseIf tbl1(i, 7) Like "*[娘]*" Then
                        sb = "▼"
                    Else    '関係が無記載
                        sb = "◎"
                    End If
                    If x(xr, xc + 3) <> "" And x(xr - 2, xc + 3) = "" Then
                        x(xr - 2, xc + 3) = x(xr, xc + 3)
                        x(xr, xc + 3) = ""
                    End If

これは無事に動作しています。そこで　性別欄を除き、6列しか使わないことにしたいのです。

 tbl1(i, X)は　i行のX列名のデータではないでしょうか？
 教えて頂きたいのは　tbl1(i, ８)～tbl1(i, 11)まであるのですが　これはSheet1表のデータでしょうか? 最大7列しかないと思っているのですが、小生混乱しています。

はんにゃ

なにかで　誕生日が入っていないのメッセジがあったので　コードをみて
tbl1(i, ８)の関係していることをしりました。それで　どこのデータなんだろうとかんがえています。

おかげで大分進んだのですが
上記以外に
次の点でこまっています。

いま　sheet1　

 51 安田勘七	?	 ?	明治	10.6.23		夫
 52「細田」眞	?	?	安政	6.8.5		妻
 53 次太郎	安政	2.11.3	大正	3.10.26		息子
 54						
 55 安田清太郎	?	 ?	明治	?		夫
 56 芳名不詳	?	?	安政	?		妻

は　sheet2 に(こぴーが不安）

 	△故_安田勘七===▼故_「細田」眞					△故_安田清太郎===▼故_芳名不詳								
	｜	?　～明治10.6.23				｜	?　～明治?							
	｜		｜	?　～安政6.8.5		｜			?　～安政?					
			｜

ですが、さらに　

 57 市蔵	天保	5.9.18	大正	9.8.18		息子
 を追加すると　エラー　インデックスの範囲外である、と出ます。
どうしてでしょうか？

これを機会におしえてください。エラー　あるいはメッセージが出たときのコードの位置は
以前　黄色表示ででたように記憶しているのですが、いつのまにか　出なくなったのですが
　どのようにしたら　出てくるでしょうか？？

 まず
 nenpyokeifu_7を作成してみました。
 これは
 ＞57 市蔵
 ＞を追加すると　エラー　インデックスの範囲外である、と出ます。
 この時に起きていると思われる問題を修正して居ます。

 nenpyokeifu_6迄は、一番小さい年の1年前を
 年表の開始年とし、同時にみなしの誕生年に使用して居ましたが
 これを4年前にする事にしました。

 エラーが出るデータを載せてもらいましたが
 その他のデータがどの様に入っているのか分かりませんので
 問題は、今回推測した点とは違う所に有るかもしれません。

 エラーが解消されない様であれば、エラーが出る小さなデータを
 作成し、載せて下さい。
 （51行目からのデータですので、50行目迄が
 　どのようになっているのかわかりません。
 　ですので、2行目からデータを配置して、エラーになるような
 　サンプルデータを作成していただければと思います。）

 その変更が1点と、もう1点
 ＞性別欄を除き、6列しか使わないことにしたいのです。
 こちらにも対応させましたので、性別の列は削除して試して下さい。

 なお、これに関する変更点は　tbl1(i, 7) → tbl1(i, 6) へ
 置換しただけです。

 ＞エラー　あるいはメッセージが出たときのコードの位置は以前
 ＞黄色表示ででたように記憶しているのですが、いつのまにか　出なくなったのですが
 ＞どのようにしたら　出てくるでしょうか？？
 私は、出なくなった事が無いので分かりません。

 エラーの表示がされた時に [終了(E)] [デバッグ(D)] [ヘルプ(H)]の
 ３つのボタンが押せる状態だと思いますが、このうち
 [デバッグ(D)] を押しても、該当箇所が黄色く成りませんか？

 [終了(E)] を選んだのでは、黄色く成りません。

 なお、Web上を探せば　無料でファイルを載せられる場所がいくつか有ります。
 こちらの掲示板で、文章でのご説明と共に　その様な所を探し
 利用して頂くのも良いと思います。

 基本的には、同じコードを使用していて、Sheet1が同じなら
 Sheet2へは、同じ結果が得られると思いますので
 Sheet2の状態は載せてもらわなくても大丈夫と思います。

 ただし、「Sheet1が同じなら」が条件ですので
 今回、Sheet1の51行目からのデータを載せておられる様ですが
 この部分を2行目から配置し　実行してみた時の
 希望と異なる動きや、不具合などを教えて頂ければと思います。

 (HANA) 2009/7/6 22:40

返事がおそくなりました。（出したつもりが操作ミスで載っていませんでした）。

前６版で、エラーがでないようにデータを仮置きして　動かました。そのデータで７版も動きました。

些細なことですが　最古年の表示(和暦年）が不都合（一年加算）でした。

 天明	3	1782
 	3	1783
 	4	1784

 Sheet名の変更、享年表記（余白と"："）の削除をしました。
 With Sheets("データ表")
 With Sheets("年号対応表")
 With Sheets("系譜図")
        sngpse = sngpse & "享年" & se - ss + 1

  先のデータ不良によるIndex範囲外のエラーは出なくなりました。
 その上で、古い祖先や遠縁のデータには不明が多く、氏名は不詳文字、月日はX.?.?で問題ないのですが
元号や年数が不明の場合は仮のデータにしないと（最古年や元年でも良いが、本当かどうか後日不明になる）如何ともしがたい。そこで、
没年も含めて、”仮”の入力をして　その旨を結果に”慶応？”とか”慶応3?.?.?”の如く表記したのですが　如何でしょうか。
 よろしく　おねがいします。Googleあたりにファイルを載せるように考えます。

先の最古の和暦年数が一年加わったのを下記のコードを修正して直ったのですが、他にいたずらしないでしょうか？

              'y(1, 2) = nn - Application.Index(sr, ti) + 1 '一年加算された
             y(1, 2) = nn - Application.Index(sr, ti)

ありがとうございます

下記データが、前のメールのときは　動いていたのですが
こんど開いたら　”型が一致しません”となります。

 [2]長田(新町)文之助	 ?	 ?	天明	7.7.20	父
 [3]芳名不詳	?	 ?	文化	13.8.27	母
 [4]伊右衛門(長砂家	文化	1.3.10	安政	4.6.30	息子
 [5]					
 [6]長田伊右衛門(長砂家	文化	1.3.10	安政	4.6.30	父
 以下略

わかりました。見掛けは単に”？”なのですが　どうしたわけか”スペース？”であったので
スペースをとったら　うごきました。
元号のときもそうでした。スペースが明示され、容易に気づくようにか　入らないようにする方法はあるのでしょうか　

 私は、はんにゃさん　或いは
 決められたルールに則って入力が出来る方
 が使用すると思ってコードを書いていますが
 その点はご理解頂けていますか？

 前スレの初っぱなにも
 ◆御使用に成られる場合は、ルールに則ったデータを
 　用意しておいてもらう必要が有ります。
 ◆あくまでも「完璧な物」ではありませんので
 　必要な所は書き出した後で、手直しをしてください。
 と書きましたが、コード的にもその程度の物です。

 しかも、これって　使い捨てですよね？
 マクロを実行して、系譜図を作成し、レイアウトを整えても
 再度実行すると、レイアウトを全て整え直す必要が出てきますので
 二回目の実行は出来ないと思います。

 そんなに沢山の系譜図を作成する予定が有るわけでも無いのですよね？

 コードは一応、nenpyokeifu_8を作成しました。

 ＞元号や年数が不明の場合は仮のデータにしないと
 これがどの様な入力を想定して居られるのか良く分かりませんが
 この様な入力への対応を想定しました。
年号	年月日	
慶応	?	　慶応元年扱い
慶応	3?.?.?	　慶応30年扱い
	19??.?.?	　1900年扱い

 ＞最古年の表示(和暦年）が不都合（一年加算）でした。
 こちらは修正しました。

 ＞スペースが明示され、容易に気づくようにか　入らないようにする方法
 コード内にTrimを追加しました。

 (HANA)　2009/7/9  0:51

重ねて　おりがとうございます

使い捨てではないかとの疑念はもっともですが、そんなもったいないことを
するつもりはありません（Hanaさんに失礼ですし、小生自身もそれなりのエネルギを
費やしていることもあります）。少なくとも身内でこれは便利と認めている（これからのこどもの内で認めるであろう）
者には　大いに広めて行こうと考えています。

そのためにも　ちょっとでも使いやすいものと　いろいろお願いして大いなるご指導を頂いたことを感謝します。
　

 スペースミスについて　そるほどTrimという便利な機能を追加頂き　ありがたいです
 第一行年（　結果　天明２）は　生年、没年デ―タの最古年（データ　天明7年）から
決まったとおもうのですが、5年前とするルールでしょうか？(以前に説明があったかもしれないのですが　記憶と記録がたどれなくすみません）

データの入力はルールに従い、ミスをなくすことを前提に使いたいとは思います。

ただデータ自体が　遠縁や　祖先には不明の場合が多く、
そうかといって　見なしの結果を後から読んだときに、そのとおりと伝わるのは避けたいと
かんがえました（これなど　最初からの仕様が不足でした）。

 年号	年月日	
 慶応	?	　慶応元年扱い
 慶応	3?.?.?	　慶応30年扱い
 	19??.?.?	　1900年扱い
 	197?.?.?　　は　1970年扱い
 これらは大変ありがたい表記です

 この年号自体が不確実なデータの場合
 年号表記　慶応？と記載されると良いのですが　いかがでしょうか
 (西暦の表記をつかうことで　その大まかさを示すことができるのですが）

そして　　系譜図を作成後、それをコピーして統合系譜図として
各系譜間の繋がり　婚姻の氏名でC&Pをして　累系を繋げます。
見てもらうべき　Googledocsに入れたのですが　当然あなただけにみてもらうということは
システム上で　あなたのアドレスがあると良いようですが、いかがでしょうか。

なにか手があれば　よいのですが。なければ　名前を書き直して　上げます。
そして　Publishing公開にします。

 　
＞当然あなただけにみてもらうということはシステム上で　あなたのアドレスがあると良いようですが、いかがでしょうか。
 　
このような場所で、特定の個人以外を置き去りにするのは余り良い行為と言えないように思います。
（今現在、はんにゃさんの質問に応じているのは結果的にはHANAさんだけですが）
 　
＞名前を書き直して　上げます。そして　Publishing公開にします。 
 　
とするのが良いのではないでしょうか。
答えられなくても、勉強したい人はいるのです。

 （とおりすがり）

 そうですね、面倒ですが
 ＞名前を書き直して　上げます。そして　Publishing公開にします。
 にしていただくのが良いと思います。

 他の方から
 「こうやった方が　処理も簡単だし汎用性も有るよ」
 なんてコメントが有るかもしれませんので。

 それから、有る程度問題なく動いているようですが
 多くの人が使うのであれば、当然行っておくのが良い
 と思われる様なエラー処理でさえ　行っていません。

 もしも、はんにゃさんの目の届かない所での使用を
 考えて居られるので有れば、その辺りには一つずつ
 エラー処理を入れていく必要が有るのではないかと思います。
 （それに参加するつもりは有りませんが。）

 ＞この年号自体が不確実なデータの場合
 ＞年号表記　慶応？と記載されると良いのですが　いかがでしょうか
 仰って居られる意味がよく分かりません。
 どこへ記載をする時の話でしょう？

 ＞第一行年（　結果　天明２）は　生年、没年デ―タの最古年（データ　天明7年）から
 ＞決まったとおもうのですが、5年前とするルールでしょうか？
 最古年の年を入れると5年前
 入れないと4年前です。

 この変更で、もう一箇所変更の必要が有ったのを忘れていました。
    Call snsr(tbl1, nn, totbl)
 の下は
    If nn + 4 < 999 Then
        MsgBox "999年より前のデータが有ります。"
        Exit Sub
    End If
 にして下さい。

 生年或いは没年が999年の人が居た場合
 年表は995年（長徳元年）から始まります。

 最古年が天明7年でしたら、年表は天保3年から始まると思います。
 もう一度、コードとデータを確認して実行してみて下さい。

 (HANA)

７版では

 Private Function knm(bngp, nm)
     If nm = "" Then
         knm = "≪不明≫"
     Else
         If bngp <> "" Then
              knm = "故_" & nm
          Else
             knm = nm
         End If
     End If
 End Function

 こんどはすこし違います。それ故か　名前の前に故がつきます。

　それと　生年で　2009.7.7 や平成 21.7.7 がIndex外ではいりません。

平成１９年　２００７年までは　はいります。どこかで制限があるのでしょうか？

　それでは名前をちょっと変えたデータでファイルをPublishingにします。
　あがったら連絡しますので　みてください。

 >エラーの表示がされた時に [終了(E)] [デバッグ(D)] [ヘルプ(H)]の
 ３つのボタンが押せる状態だと思いますが、このうち
 [デバッグ(D)] を押しても、該当箇所が黄色く成りませんか？

Index範囲外のメッセージがでるとき、いろいろ探しています。　上の表示がVBのメッセージBox（OKとキャンセル）でもないし
Excel(Fファイルの続き）でもみあたらないのです。
　VBのWindow([デバッグ(D)]は　つぎに縦長にいろいろのメニュうー（ステップインなど）がでますが　そのどれを選べばよいでしょうか。

 不明なとき
 慶応　年号不明は　慶応の次欄に？を入れると　元年扱いで　表示に慶応？となります。
　一方慶応自体が不確かなときにもデータを入れたい。そして　結果表示に元年あつかいとしても　例えば慶応仮とかの表示を得たいです。
　特に長い年号のときに　元年ではかけはなれるので　ある程度予想して不明年をいれたい。
そこで４５仮.？.？のようにできないでしょうか？　４？.?.?を４０．？.?との扱いの区別が着かないのこともあり、４５仮というようにできると良いですね。

本当に　いろいろの不明入力に対応するのは　大変難しいことをしりました。いまさらですが　お願いできたらありがたいです。

 検証不足かもしれませんが
 １．名前の前に故がつきます。
Private Function knm(bngp, nm)
    If nm = "" Then
        knm = "≪不明≫"
    Else
        If bngp <> "" Then
            knm = "故_" & nm
        Else
            knm = nm
        End If
    End If
End Function
 にして下さい。

 ２．生年で　2009.7.7 や平成 21.7.7 がIndex外ではいりません。
    ReDim y(1 To Year(Date) - nn, 1 To 3)
 を
    ReDim y(1 To Year(Date) - nn + 4, 1 To 3)
 にしてみて下さい。

 ３．Index範囲外のメッセージがでるとき、いろいろ探しています。
 済みません、もう少し分かりやすい文章を書いて頂ければと思います。
 何を探しているのですか？
 ＞上の表示がVBのメッセージBox（OKとキャンセル）でもないし 
 上の表示って何のこと？何か表示はでるの？出ないの？
 何が出ていて、何が見えているのですか？

 順序立てて説明してもらわないと、何の事やらさっぱり分かりません。

 新しいブックで簡単なコードを作成し、やってみたらどうなりますか？

 ４．そこで４５仮.？.？のようにできないでしょうか？
 ＞しっかり考えました。
 ＞　１．1900年以前の年月日にも対応
 ＞　２．生涯年数の追加
 ＞で完了とします。
 と言うお言葉を頂いていたと思います。

 「よく考えてください」では、よく考えられないようですので
 データ表を完成させ、その中からパターンを選び出し
 ご自身で一度「系譜図」を作成して見られるのが良いと思います。

 ○慶応	3?.?.?
 ○４５仮.？.？
 等の入力が有った方が便利なことはその過程で発覚していたと思いますし
 実際に作業をしてみると、他のご要望も見つかるかも知れません。

 (HANA)

ありがとうございました。

 さきほど　GoogleDocsのURLを記載したつもりが　出ません。
再度　書きます。
 http://spreadsheets.google.com/ccc?key=t-AQD_JlWb2o-2Cz7wr9neQ&hl=en
 如何でしょうか？　これはこのメールを受ける前に上げ載せてものです。
　１，２項の修正はまだなっていませんが、この点はなおして　再度上げ載せなおします。

はい、不確定な年号、年数の入力事例は　やっているうち　実際あって　希望し、

 相談したものです（設計が不十分でした）。仮の位置は当面西暦で？をつけていれます。　
 その間勉強します。
 どうしてもNGのときは　具体的な質問で　乞うようにします。

 Indexのエラー該当表示も　詳しい説明が(多分）ミスで　載せられませんでした。
 再度書きます。
 >エラーの表示がされた時に [終了(E)] [デバッグ(D)] [ヘルプ(H)]の３つのボタン
 が押せる状態だと思いますが、
 このうち [デバッグ(D)] を押しても、該当箇所が黄色く成りませんか？

 上の３つのボタンはどのWindowにでるのでしょうか。
 まず　エラー表示のVisualBasicのメッセージBoxはボタン表示が「OK」と「Help」の２つで、
  VisualBasicコードのWindowはメニューボタン（バー）が
 左からファイル（F)、編集（E)などです。ここにデバッグ（D)はありますが、
 つぎのメニューはステップインなどです。多分違うようです。後はExcel本体のWindowです。
 なお版はOffice Excel2003　です。
 あるいは　エラー表示の状態で　KeyーDを押しても、ALT+Dでも、Ctrl+Dでも　かわらない。
 エラー表示がでたままでは　VisualBaiscのWIndowが　最小のままで　表示されない。

 よろしく　おねがいします

http://spreadsheets.google.com/pub?key=tjvhcl2wffHCsqksIAN9a-w&output=html

 これがあたらしいURLです。
どうか　HANAさん　とおりすがりさん　よろしく助言ください。
そちらで入力を変えてみることはできますか？

 済みませんが、載せて下さったファイルの使用方法が分かりません。
 エクセルファイルをそのまま載せていただけると良いのですが。

 エラー表示のウィンドウに「デバッグ」が無いのはよく分かりません。
 　全てのブックを閉じて、新しいブックを開き
 　エラーが出るようなマクロを作成し確認
 しても　問題の箇所は黄色く成らないのでしょうか？

 また、そのエラー表示の画像でも　載せておいていただけると良いかもしれませんね。

 データ表は完成しましたか？
 「やっているうち　実際あって　希望し、相談したものです」
 こんな事は多々あります。
 有る程度は仕方ないと思います。
 しかし、コードにする前に　実際を想定して面倒でも作業をやって頂けていれば
 その段階で充分要望として出てきたことだと思います。

 現在、何が不具合として残っているのか分かりませんが
 年の決定は　和暦列と、年月日列の最初の「.」以前で決まります。

 和暦列には、年号対応表に有る和暦　或いは「？」以外は入力不可です。
 また、年月日列の最初の「.」以前は、数字或いは「？」以外は入力不可です。
 （入力不可　とは、現在のままでは希望する結果が得られない　と言う事です）

 ただし、年月日列の最初の「.」より後は　何がどの様に入っていても　関係有りません。

 例えば　「慶應　　3.?.?仮」は、慶應3年扱いで
 系譜図には「 慶應3.?.?仮 」と表示されます。

 当然、月日も不明なのではないかと思いますが「慶應　3.仮」等でも
 エラーには成らず、慶應3年扱いに成ります。
 この辺りで手を打ってはどうでしょう？

 計算できる年が入力されていたら、享年が計算されます。
 もしも「仮」が入っていたら、享年を出さない事にする
 と言うルールにするなら、コードは少し変更が必要に成りますね。

 (HANA)

ざんねん　ファイルを上げ載せ、Webに載ったので　大丈夫かと　操作を確認しないままでした。
さて　どうしたら　ファイル自体を共有できるか　見たのですが　結局わかりません。
たいへん　失礼ながら　このGoogleでのやり方がわからないので（ご存知よかったら　教えてもらえれば幸いです）　急遽別のを探して以下のところにのせませした。

 どうでしょうか？
 http://www.mediafire.com/myfiles.php
 http://www.mediafire.com/?sharekey=4e725c67a82634db4c17ca8801618ef7e04e75f6e8ebb871

 鍋貞太郎	?	 ?	?		父
 平」きみ	?	?	?		母
 満	大正	?	?		娘
 親	大正	?	?		息子
 真⇒北	大正	?	?		娘

 では　故人にならない

 とし	大正	3.11.22	昭和	?	娘

 では故人になる。？のときは　年号がないと故の文字が入らない。
 空欄は生存者ですが　？の記載は没年不明で故人にしたいのですが　
いかがでしょうか？

 なるほど　
 ＞例えば「慶應　　3.?.?仮」は、慶應3年扱いで、 系譜図には「 慶應3.?.?仮 」と表示されます。
 ＞
  　 は　良いです。仮は年号や年自体を仮と出来ないが、仮の文字は全体を仮とする意味にきめて
使います。そして　
 ＞「仮」が入っていたら、享年を出さない事にする、 と言うルールにするなら、コードは少し変更が必要に成りますね。

はい、データを調査しながらのソフト作りで　失礼なことになったかとおもいます。
おゆるしください。

エラー表示の画面はなんとか記録して　またファイルを上げます。
ありがとうございました。（はんにゃ）

 >エラー表示のウィンドウに「デバッグ」が無いのはよく分かりません。
 hppt://www.mediafire.com/myfiles.php
ごらんになれますか?　これは　データ不良でIndex　エラーがでたところです。
 版が違うのでしょうか？　小生の大いなる理解不足でしょうが。

なお、コード不良でコンパイラ　エラーのときは　黄色の表示がでました。希望はデータ（あるいはコード）が不適切で　エラーが出て　プログラムが途中でとまるようなエラー表示がでた場合、黄色の該当箇所の明示があるのを期待しています。

 ”平成X”の入力では　メッセージBOXに　”999年以前のデータがあります”と出る。
 一方　”誕生日の入力が無い場合は　氏名が出ます”。このように
 該当氏名が出ると良いのですが。
 ”999年以前のデータがあります”の場合もそれを期待して、
 MsgBox "999年以前のデータが有ります。" & vbLf & tbl1(i, 1)

 と修正しました。全体を調べ、最古nnについてだから　このコードは正しくないようです。
 データを読み取るときに調べないといけない。
　再度検討します。

現況は　

 没年で　昭和？　
 高智	昭和?	9.11.18	昭和	4.9.24	夫
 　=>　インデックスが範囲外

 高智	昭和?	?9.11.18	昭和	4.9.24	夫
 　=>　型が一致しません。

 高智	昭和?	?.11.18	昭和	4.9.24	夫
 　は正常　昭和??.11.18～昭和4.9.24の表記

 高智	昭和?		昭和	4.9.24	夫
 　は正常　昭和??.11.18～昭和4.9.24の表記

 高智	昭和?		昭和	4.9.24	夫
 　は正常　昭和?～昭和4.9.24

 高智	昭和?		昭和	4.9.24　空欄	 
  　=>　誕生日が未入力です　高智　
　は不適切

上記の

 高智	昭和?		昭和	4.9.24	夫
  　は正常　昭和??.11.18～昭和4.9.24の表記
 は　誤りで　Index範囲外でした。

たびたびすみません。

 高智	昭和?	空欄　　昭和　4.9.24	夫
 は　正常　昭和?～昭和4.9.24
 でした。

同じ入力を書いて、前の結果が間違っていました。　

 ファイルを見せていただきました。

 エラーMSGBOXを載せていただいた方は
 見れなかったのですが。。。

 １．エラー時コードがハイライトされない件に関しては

 コードを「標準モジュール」に書いてください。
 現在は、Sheet2（系譜図）のシートモジュールに書いてありますね。

 ２．？のときは　年号がないと故の文字が入らない。

 あちらを修正すると、こちらに問題が。。。って状況ですね。（笑）
 '======
Private Sub snsr(tbl1, nn, totbl)
    Dim dic As Object
    Dim i As Long, ii As Long
    Dim kn
Set dic = CreateObject("scripting.dictionary")
nn = Year(Date)
    For i = 1 To UBound(totbl, 1)
        dic(totbl(i, 1)) = totbl(i, 2)
    Next
    For i = 2 To UBound(tbl1, 1)
        For ii = 0 To 1
            tbl1(i, 2 + ii * 2) = Trim(tbl1(i, 2 + ii * 2))
            tbl1(i, 3 + ii * 2) = Trim(StrConv(tbl1(i, 3 + ii * 2), vbNarrow))
                kn = Split(tbl1(i, 3 + ii * 2) & ".", ".")(0)
            If tbl1(i, 2 + ii * 2) = "" Then
                tbl1(i, 8 + ii) = kn
                If kn = "?" Or kn = "" Then
                    tbl1(i, 8 + ii) = kn
                Else
                    tbl1(i, 8 + ii) = Replace(kn, "?", 0)
                End If
            Else
                If dic.exists(tbl1(i, 2 + ii * 2)) Then
                    If kn = "?" Or kn = "" Then
                        tbl1(i, 8 + ii) = dic(tbl1(i, 2 + ii * 2))
                    Else
                        tbl1(i, 8 + ii) = dic(tbl1(i, 2 + ii * 2)) + Val(Replace(kn, "?", 0)) - 1
                    End If
                Else
                    If tbl1(i, 2 + ii * 2) = "?" Then
                        tbl1(i, 8 + ii) = tbl1(i, 2 + ii * 2)
                    Else
                        tbl1(i, 8 + ii) = kn
                    End If
                End If
            End If
            If Val(tbl1(i, 8 + ii)) > 1 Then
                nn = Application.Min(nn, tbl1(i, 8 + ii))
            End If
            tbl1(i, 10 + ii) = tbl1(i, 2 + ii * 2) & tbl1(i, 3 + ii * 2)
            If tbl1(i, 2 + ii * 2) & kn Like "*[?]*" Or tbl1(i, 8 + ii) = "" Then
                tbl1(i, 12) = 1
            End If
        Next
    Next
nn = nn - 4
Set dic = Nothing
End Sub
 '------
　これに変更してください。

 また、今回の件とは直接関係ありませんが↓も変更しておいて頂ければと思います。
 '======
Private Function sngpse(ss, se, tngp, bngp, nr)
    If tngp = "" Then
        sngpse = "≪不明≫～"
    Else
        sngpse = tngp & "～"
    End If
        sngpse = sngpse & bngp
    If nr = Empty Then
        sngpse = sngpse & "享年" & se - ss + 1
    End If
End Function
 '======

 ３．＞現況は

 と、データを載せてくださっていますが
 表は、エクセルで作成し、貼り付けてください。

 ４．＞ ”平成X”の入力では　メッセージBOXに　”999年以前のデータがあります”と出る。

 どの様な入力を言っておられるのかわかりません。

 (HANA)

 ↑の「sngpse」のコードは書き替えました。
 既に確認後でしたら、もう一度変更していただければと思います。

 (HANA)

ありがとうございます

 愚痴”早朝 返事を書いたつもりが　掲載されない。たびたび失敗しているのに 又だ！”

さて前のエラーMSGBOXは　　

 http://www.mediafire.com/myfiles.php
 http://www.mediafire.com/imageview.php?quickkey=wtzcyywtikz&thumb=4
 です。
 やっと　標準モジュールというところに　挿入でコードを入れ替えました。
すると　エラーのときは、教えられたような表示が出て、デバッグボタンで　該当コード行が黄色になりました。ありがとうございました。基本をしらない人に教えられるのは　大変な負担でしょう。感謝します。

新しいコードもありがとうございます。これについては　後ほど試行して　
整理して　診てもらえればありがたいです。

はんにゃ

 http://www.mediafire.com/myfiles.php
 http://www.mediafire.com/download.php?lmojmynziti

 現況のコードです。
 一部書き換えたところはコメントがあります。
 データの最後を変えて　ご覧になると以下がでるはずです。
 現況では　始めの課題のみが　享年１がでることのみです

 現況は　						
 A	B	C	D	E	F	
 高智	　	　	昭和	4.9.24		
 高智２	昭和	59.11.18	昭和	4.9.24	息子	
 [當]千	昭和	43.8.30			妻

  　=>　MsgBox夫/妻未入力（これは正常） 　=>結果は

 ▼[當]千=〒=≪不明≫						
 	昭和43.8.30～					
 		｜	<不明>～享年1			
 　=>　課題　高智が夫か子か不明なので　≪不明≫で良いが、故が出ない。また　没年が表示で出ない。　享年１と出る。生年　没年不明の場合　無記載か享年不明とか　したい。						
  　=>　課題２　コードを変えず、正しい入力をすると　結果は正常です。　これで解決とする。

 高智２	昭和	59.11.18	昭和	4.9.24	息子	
 高智	　	　	昭和	2.9.24	夫	
 [當]千	昭和	43.8.30			妻

 ｜						
 △故_高智=〒=▼[當]千						
 	<不明>～昭和2.9.24					
 		｜	昭和43.8.30～

 A	B	C	D	E	F	
 高智２	昭輪	59.11.18	昭和	4.9.24	息子	
  　=>　MsgBox　生年999以前　=>　この理由は年号にミスがあり、西暦59.とみなして警告。　
 年号あるいは年を直すか　						
 和暦で　999年以上はないから　必ず年号の誤記と言える。

 A	B	C	D	E	F
 高智２	昭和?	59.11.18	昭和	4.9.24	息子
  　=>　MsgBox　生年999以前　=>　この理由は年号にミスがあり、西暦59.とみなして警告。　
 年号ある いは年を直すか　					
  　=>　MsgBox　生年999以前　=>　昭和が不確定の？は　年数の前に　?59.11.18 と　直す

 A	B	C	D	E	F
 高智２	昭和	? 59.11.18	昭和	4.9.24	息子
  　=>　結果は　					
 △故_高智２					
 ｜	昭和? 59.11.18～昭和4.9.24				
  　=>　年号が?　ということが表記された。これで解決。

 A	B	C	D	E	F
 高智	昭和?	? 59.11.18	昭和	2.9.24	夫
 　=>　エラー型が一致しない　　 cyi = tbl1(i, 8) '型がLong数値で、？の文字はNG					
 これは西暦とみて　？文字があるので　型が不一致　この書き方はしないように心がけるが　該当入力のMessageを出せると　うれしいです。

 高智	昭和?	?.11.18	昭和	2.9.24	夫	
  　=>　結果は 年不明で最古に記載　これでOK　						
 △故_高智=〒=▼[當]千						
 	昭和??.11.18～昭和2.9.24

 高智	昭和?		昭和	2.9.24	夫	
 [當]千	昭和	43.8.30			妻	
 　=>　結果は 生年不明で　妻の生年に記載　これでOK						
 △故_高智=〒=▼[當]千						
 	昭和?～昭和2.9.24					
 		昭和43.8.30～

 最後のやっつけなので
 正常な所が異常になっているかもしれません。

 '------
Sub nenpyokeifu_9()
    Dim tbl1, totbl, x, y
    Dim nr As Range, sr As Range
    Dim xc As Long, xr As Long, nn As Long
    Dim i As Long, ii As Long, erf As Long
    Dim fyi As Long, cyi As Long, mcy As Long
    Dim p1(6), p2(6)
    Dim sb As String
    With Sheets("データ表")
        tbl1 = .Range("A1").Resize(.Range("A" & Rows.Count).End(xlUp).Row + 1, 12)
    End With
    With Sheets("年号対応表")
        totbl = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp)).Resize(, 2)
        Set nr = .Range(.Range("E2"), .Range("E" & Rows.Count).End(xlUp))
        Set sr = .Range(.Range("D2"), .Range("D" & Rows.Count).End(xlUp))
    End With
    Call snsr(tbl1, nn, totbl, erf)
    If erf = 1 Then
        Exit Sub
    End If
    ReDim y(1 To Year(Date) - nn + 4, 1 To 3)
    Call np(y, nn, nr, sr)
    ReDim x(1 To UBound(y, 1), 1 To Columns.Count)
    xc = 2 '作図の左端D列から
    For i = 2 To UBound(tbl1, 1)
        If tbl1(i, 1) = "" Then
            If tbl1(i - 1, 1) <> "" Then
                fyi = psn(nn, p1(2), p2(2))
                xr = fyi - nn + 1
                x(xr, xc) = p1(0) & knm(p1(3), p1(1)) & "===" & p2(0) & knm(p2(3), p2(1))
                x(xr + 1, xc + 1) = sngpse(p1(2), p1(3), p1(4), p1(5), p1(6))
                x(xr + 2, xc + 3) = sngpse(p2(2), p2(3), p2(4), p2(5), p2(6))
            '親の系譜線
                If fyi > nn Then
                    x(xr - 1, xc) = "｜"
                End If
                    x(xr + 1, xc) = "｜"
                    'x(xr + 2, xc) = "｜"
            '子の系譜線
                If xr < mcy Then
                    For ii = xr + 2 To mcy + 1
                        If x(ii, xc + 2) = "" Then
                            x(ii, xc + 2) = "｜"
                        End If
                    Next
                End If
                xc = xc + 5  ' コメント　この追加数字が系譜幅
                fyi = 0: cyi = 0
                Erase p1: Erase p2
                mcy = 0
            End If
        Else
            If tbl1(i, 6) Like "*[父,夫]*" Then
                sb = "△"
                Call pd(tbl1, i, sb, p1, p2)
            ElseIf tbl1(i, 6) Like "*[母,妻]*" Then
                sb = "▼"
                Call pd(tbl1, i, sb, p1, p2)
            Else
                If tbl1(i, 8) = "" Or tbl1(i, 8) = "?" Then
                        MsgBox "誕生日が未入力です。" & vbLf & tbl1(i, 1)
                Else
                    cyi = tbl1(i, 8)
                    xr = cyi - nn + 1
                    If tbl1(i, 6) Like "*[息子]*" Then
                        sb = "△"
                    ElseIf tbl1(i, 6) Like "*[娘]*" Then
                        sb = "▼"
                    Else    '関係が無記載
                        sb = "◎"
                    End If
                    If x(xr, xc + 3) <> "" And x(xr - 2, xc + 3) = "" Then
                        x(xr - 2, xc + 3) = x(xr, xc + 3)
                        x(xr, xc + 3) = ""
                    End If
                    If x(xr, xc + 3) <> "" And x(xr - 2, xc + 3) = "" Then
                        x(xr - 2, xc + 3) = x(xr, xc + 3)
                        x(xr, xc + 3) = ""
                    End If
                    x(xr, xc + 2) = sb & knm(tbl1(i, 9), tbl1(i, 1))
                    x(xr + 1, xc + 3) = sngpse(tbl1(i, 8), tbl1(i, 9), tbl1(i, 10), tbl1(i, 11), tbl1(i, 12))
                    mcy = Application.Max(xr, mcy)
                End If
            End If
        End If
    Next
With Sheets("系譜図")
    .Cells.ClearContents
    .Range("A1").Resize(UBound(y, 1), 3) = y
    .Range("D1").Resize(UBound(y, 1), xc + 3) = x
    ' C列に西暦を入れるためC1→D1に
    .Range("C1").Resize(UBound(y, 1), 1).Copy .Range("D1").Cells(1, xc + 5)
End With
Set nr = Nothing
Set sr = Nothing
End Sub
 '======
Private Function knm(bngp, nm)
    If nm = "" Then
        knm = "≪不明≫"
    Else
        If bngp <> "" Then
            knm = "故_" & nm
        Else
            knm = nm
        End If
    End If
End Function
 '======
Private Function sngpse(ss, se, tngp, bngp, nr)
    If tngp = "" Then
        sngpse = "≪不明≫～"
    Else
        sngpse = tngp & "～"
    End If
    If ss & se & tmgp & bngp & nr = Empty Then
        sngpse = sngpse & "≪不明≫"
    Else
        sngpse = sngpse & bngp
    End If
    If nr = Empty And se <> Empty And ss <> Empty Then
        sngpse = sngpse & "享年" & se - ss + 1
    End If
End Function
 '======
Private Function psn(nn, fys, mys)
    If fys <> "" Then
        If fys = "?" Then
            psn = nn
        Else
            psn = fys
        End If
    Else
        If mys = "?" Or mys = "" Then
            psn = nn
        Else
            psn = mys
        End If
    End If
End Function
 '======
Private Sub pd(tbl1, i, sb, p1, p2)
    If p1(0) = Empty Then
        p1(0) = sb: p1(1) = tbl1(i, 1): p1(2) = tbl1(i, 8): p1(3) = tbl1(i, 9)
        p1(4) = tbl1(i, 10): p1(5) = tbl1(i, 11): p1(6) = tbl1(i, 12)
    Else
        p2(0) = sb: p2(1) = tbl1(i, 1): p2(2) = tbl1(i, 8): p2(3) = tbl1(i, 9)
        p2(4) = tbl1(i, 10): p2(5) = tbl1(i, 11): p2(6) = tbl1(i, 12)
    End If
End Sub
 '======
Private Sub np(y, nn, nr, sr)
Dim i As Long, ti As Long
            y(1, 3) = nn
            ti = Application.Match(y(1, 3), sr)
            y(1, 1) = Application.Index(nr, ti)
            y(1, 2) = nn - Application.Index(sr, ti) + 1
    For i = 2 To UBound(y, 1)
            y(i, 3) = y(i - 1, 3) + 1
            ti = Application.Match(y(i, 3), sr)
            y(i, 2) = y(i, 3) - Application.Index(sr, ti) + 1
        If y(i, 2) = 1 Or y(i, 2) Mod 10 = 0 Then
            y(i, 1) = Application.Index(nr, ti)
        End If
        If y(i - 1, 2) = 1 Then
            y(i - 1, 2) = "元年"
        End If
    Next
End Sub
 '======
Private Sub snsr(tbl1, nn, totbl, erf)
    Dim dic As Object
    Dim i As Long, ii As Long
    Dim kn
Set dic = CreateObject("scripting.dictionary")
nn = Year(Date)
    For i = 1 To UBound(totbl, 1)
        dic(totbl(i, 1)) = totbl(i, 2)
    Next
    For i = 2 To UBound(tbl1, 1)
        For ii = 0 To 1
            tbl1(i, 2 + ii * 2) = Trim(tbl1(i, 2 + ii * 2))
            tbl1(i, 3 + ii * 2) = Trim(StrConv(tbl1(i, 3 + ii * 2), vbNarrow))
                kn = Split(tbl1(i, 3 + ii * 2) & ".", ".")(0)
            If tbl1(i, 2 + ii * 2) = "" Then
                tbl1(i, 8 + ii) = kn
                If kn = "?" Or kn = "" Then
                    tbl1(i, 8 + ii) = kn
                Else
                    tbl1(i, 8 + ii) = Replace(kn, "?", 0)
                End If
            Else
                If dic.exists(tbl1(i, 2 + ii * 2)) Then
                    If kn = "?" Or kn = "" Then
                        tbl1(i, 8 + ii) = dic(tbl1(i, 2 + ii * 2))
                    Else
                        tbl1(i, 8 + ii) = dic(tbl1(i, 2 + ii * 2)) + Val(Replace(kn, "?", 0)) - 1
                    End If
                Else
                    If tbl1(i, 2 + ii * 2) = "?" Then
                        tbl1(i, 8 + ii) = tbl1(i, 2 + ii * 2)
                    Else
                        MsgBox "年号が不正です。" & vbLf & _
                        tbl1(i, 1) & "　" & IIf(ii = 0, "生年号　", "没年号　") & tbl1(i, 2 + ii * 2) & vbLf & _
                        "データ表　" & Cells(i, 2 + ii * 2).Address(0, 0) & "　セル"
                        erf = 1
                        Exit Sub
                    End If
                End If
            End If
            If Val(tbl1(i, 8 + ii)) > 1 Then
                nn = Application.Min(nn, tbl1(i, 8 + ii))
                If nn < 999 Then
                    MsgBox "年が不正です。　" & nn & "　年" & vbLf & _
                    tbl1(i, 1) & "　" & IIf(ii = 0, "生年月日　", "没年月日　") & tbl1(i, 2 + ii * 2) & tbl1(i, 3 + ii * 2) & vbLf & _
                    "データ表　" & Cells(i, 2 + ii * 2).Address(0, 0) & "　セル"
                    erf = 1
                    Exit Sub
                End If
                If Val(tbl1(i, 8 + ii)) > Year(Date) Then
                    MsgBox "年が不正です。　" & Val(tbl1(i, 8 + ii)) & "　年" & vbLf & _
                    tbl1(i, 1) & "　" & IIf(ii = 0, "生年月日　", "没年月日　") & tbl1(i, 2 + ii * 2) & tbl1(i, 3 + ii * 2) & vbLf & _
                    "データ表　" & Cells(i, 2 + ii * 2).Address(0, 0) & "　セル"
                    erf = 1
                    Exit Sub
                End If
            End If
            tbl1(i, 10 + ii) = tbl1(i, 2 + ii * 2) & tbl1(i, 3 + ii * 2)
            If tbl1(i, 2 + ii * 2) & kn Like "*[?]*" Or tbl1(i, 8 + ii) = "" Then
                tbl1(i, 12) = 1
            End If
        Next
    Next
nn = nn - 4
Set dic = Nothing
End Sub
 '------

 それにしても
 ＞ 高智２	昭和	? 59.11.18	昭和	4.9.24	息子
 この記述なら、確かに問題ないですね。
 驚きました。

 １．生年　没年不明の場合
 ≪不明≫～≪不明≫　と表示されます。

 ２． 高智２	昭輪	59.11.18	昭和	4.9.24	息子
 　　 高智２	昭和?	59.11.18	昭和	4.9.24	息子
 年号の記入ミスと考え、メッセージを出します。

 ３．年の計算をした結果999より小さい場合　または
 　　未来の年が入力された場合、メッセージを出します。

 いずれのメッセージも、処理を途中で終了しますので
 そのつどデータを書きなおす必要があります。

 (HANA)

ありがとう　ございました。
はい　ここまでしてもらえれば　良いかとおもいます
試行をいたして、結果を報告し、また　９版を上げ載せます。

HANA san　すっかり報告がおくれました。

 問題の所在がやっとわかりました。
 実は

 [大｣良	明治	41.3.12	平成	4.9.24	父								
 鍋とし	大正	3.11.22	昭和	?	母								
 忠	昭和	13.9.14			息子								
 恵	昭和	16.7.5			娘								
 悳	昭和	18.9.22		2003.6.2	娘								
 憲	昭和	22.7.27			息子								
 慎	昭和	26.6.23			息子

 [大｣良	明治	41.3.12	平成	4.9.24	父								
 鍋とし	大正	3.11.22	昭和	?	母								
 忠	昭和	13.9.14			息子								
 恵	昭和	16.7.5			娘								
 悳	昭和	18.9.22	平成	15.=2003.6.2	娘		高智２	昭和	? 59.11.18	  昭和	4.9.24	息子	
 憲	昭和	22.7.27			息子								
 慎	昭和	26.6.23			息子

 の入力をしました。同じ入力のつもりです。但し後の娘　悳の右欄には　
 別の書き込みが入っています。

 これを系譜図実行すると

 前の系譜線では　昭和18.9.22～2003.6.2享年61　ですが
 後の系譜線では　昭和18.9.22～平成15.=2003.6.2　で　享年が表示されません。

 この違いは　右側の欄の書き込みによるものとわかりました。
 勝手な思い込みで入力のデータ表では　A~F列以外は使われていない列セルと理解して
 メモ代わりに書き込んでいました。

 これが　以前尋ねた　tbl1(i, 8), tbl1(i, 9)...は　F列より右セルの内容に関係するのでしょう。

 念のための確認ですが、データ欄の右側は空欄でないといけないでしょうか？

 現在メモとして　第１行目に書き込んでいますが　それが無難でしょうか？

 後　努力しているのは　系譜図の１行目を表示の最古年として　
 生年不明はこの最古年に配置記入していますが、メモ書きをしたく、生年不明の場合最古＋１年に
 書き込みたく　コードをみたのですが、読み取れず、その箇所だけでも　教えていただけませんか？

 ありがとうございます

 ＞データ欄の右側は空欄でないといけないでしょうか？
Private Sub snsr(tbl1, nn, totbl, erf)
    Dim dic As Object
    Dim i As Long, ii As Long
    Dim kn
Set dic = CreateObject("scripting.dictionary")
nn = Year(Date)
    For i = 1 To UBound(totbl, 1)
        dic(totbl(i, 1)) = totbl(i, 2)
    Next
    For i = 2 To UBound(tbl1, 1)
            tbl1(i, 12) = Empty    '←★これを追加
        For ii = 0 To 1

 して下さい。

 ＞生年不明の場合最古＋１年に書き込みたく
 ちょっと良く分かりません。
 単純に、1行目から書き出しているのを2行目から書き出すのでは駄目ですか？

 １行目はコード内で（変数x　に直接）値を入れようと
 考えて居られるのですか？

 (HANA)

 スマートなコードありがとうございました。

 仮に作ったのは　別のスレッドで入力規制があったので　それをみならって
 G１～L1の結合セルで　注意：この下の５つの列には入力禁止 と書き、
 その該当セルに　入力規制を掛けて　メッセージで　ここに入力したらいけませんと
 しました。

 もちろん　注意書きが必要ないのがスマートです。

 このような書き込み案内メッセージが他に役立つかもしれない。
 その場合　該当列の１行目を除いた他の行をそのようにするには　どうするかわかりません。
 １行目は文字が入りますので、2行目以降　入力行に応じて　規制をするというのは？
 やはり　コードによるのかな？

 > １行目はコード内で（変数x　に直接）値を入れようと 考えて居られるのですか？
 はい　そう考えて、

     ReDim x(1 To UBound(y, 1), 1 To Columns.Count)
     x(1, 1) = "ここに作成氏名を　既定のメッセージ'←★これを追加
     xc = 2 '作図の左端D列から
 結果
 延享	3	1746	ここに作成氏名を　△故_安田清太郎=〒=▼故_芳名不詳
                                          ｜	??～明治?

 となっているのですが
 この場合　△故_安田清太郎=〒=▼故_芳名不詳の表示を　延享４年に書き込むという希望です。
 あるいは
 >単純に、1行目から書き出しているのを2行目から書き出すのでは駄目ですか？
 はい、延享3年の１行目を２行目とずらしてもかまいません。

 よろしく　助言ください。
 　（はんにゃ）

 済みませんが、イメージが分かりません。

 ＞x(1, 1) = "ここに作成氏名を　既定のメッセージ'←★これを追加
 ＞延享3年の１行目を２行目とずらしてもかまいません。
 この二つは、全く違うと思うのですが。。。

 「ここに作成氏名を　既定のメッセージ」ってのは
 何の事ですか・・・？

 しかも「△故_安田清太郎=〒=▼故_芳名不詳」と同じセルに入れるのですか？

 実際は、何を　どこに（どのタイミングで？）入れようと思っているのですか？

 (HANA)

 たいへん　説明不足でした。ごめんなさい。

 はい　小生が追加したコードでは
  ＞x(1, 1) = "XXXメモXXX"　　　'←★これを追加
 結果は

 　 延享	3	1746	XXXメモXXX　△故_安田清太郎=〒=▼故_芳名不詳

 と最古年の行にメモが書き込まれます。
 △故_安田清太郎=〒=▼故_芳名不詳　は正常に所定の列の最古 年行に記載されます。（コピーがまずいかも）

 それよりも　
 >単純に、1行目から書き出しているのを2行目から書き出すのでは駄目ですか？
 これをお願いします。
 　[1] 	XXXメモXXX　
 　[2] 延享	3	1746　　　　　　　　△故_安田清太郎=〒=▼故_芳名不詳
 のようにしたいです。

 Private Sub pd(tbl1, i, sb, p1, p2)
 は以前のコロンを繋げない、一行毎に記載する内容と変わらないでしょうか（小生にはわかりやすいので
 同じならこれをつかいたい）？

 If x(xr, xc + 3) <> "" And x(xr - 2, xc + 3) = "" Then
                         x(xr - 2, xc + 3) = x(xr, xc + 3)
                         x(xr, xc + 3) = ""
                     End If
 は単純にだぶったコードで後は消しても良いでしょうか？

 ありがとうございます。　はんにゃ）

 A1セルに「XXXメモXXX」の文字を入れるだけで
 1行目の他の列には入れないってことですか・・・？

 意図が良くわかりませんが
 書き出し部分の、A1,D1,C1（D1は2箇所）の　４か所を
 A2,D2,C2　に変更してもらえば良いと思います。

 もしくは、書きだした後　一行目を挿入　とか。。。？
 （一行目を挿入するコードは　マクロの記録で取得してください。）

 ＞は以前のコロンを繋げない、一行毎に記載する内容と変わらないでしょうか
 同じです。内容は変更してませんので、前のコードから
 コピーしてもらえば良いと思います。

 ＞単純にだぶったコードで後は消しても良いでしょうか？
 本当ですね、だぶってますね。
 （8の時点ですでに。。。）
 片方は消して下さい。

 (HANA)

 ありがとうございます
 With Sheets("系譜図")
    .Cells.ClearContents
    '.Range("A1").Resize(UBound(y, 1), 3) = y
    .Range("A2").Resize(UBound(y, 1), 3) = y  '1行をメモ用に空ける。A2から系譜図 以下1⇒２へ
    .Range("D2").Resize(UBound(y, 1), xc + 3) = x  ' C列に西暦を入れるため　空けた

    .Range("C2").Resize(UBound(y, 1), 1).Copy .Range("D2").Cells(1, xc + 5)  '右端に西暦
    .Range("A2").Resize(UBound(y, 1), 1).Copy .Range("D2").Cells(1, xc + 6)  '右端に年号
    .Range("B2").Resize(UBound(y, 1), 1).Copy .Range("D2").Cells(1, xc + 7)  '右端に和暦
 End With
　
 これで1行目があきました。そこへ　メッセージのみを入れたく、その固定メッセージをそこに書けるように　コードを入れられないでしょうか？
 予め系譜図の一行セルに直接書いても　データ修正後　再度マクロ実行をすると一行目の文字は消えます。当たり前でしょうね。

 x(0, 1) = "xxxxxメモxxxxx" は当然エラーになりました。

 第２方法をとろうとおもうのですが、一行目を挿入するコードを「マクロの記録で取得」することが
検索などでみるのですが　どうも理解できないままです。
 上の.Copy.のあるコードのようなコードをつかうということでしょうか？

 ですから
 ＞＞x(1, 1) = "ここに作成氏名を　既定のメッセージ'←★これを追加
 ＞＞延享3年の１行目を２行目とずらしてもかまいません。
 ＞この二つは、全く違うと思うのですが。。。
 と書いたのですよ？

 x(1, 1) が x(0, 1) に成った所で　変数内にデータを入れる
 と言う点では同じですよね？

 もう一度お伺いしますが
 ＞＞ 1行目の他の列には入れないってことですか・・・？

 このシートは、データを仮配置するためのシートです
 ◆１行目に空行を入れたい
 と言うのは、次のシートへ貼り付ける際の要望として割と理解出来ますが
 ◆D1セルに「xxxxxメモxxxxx」の文字を入れる
 と言うのが、必要な理由が分かりません。
 ですから、何か認識違いが有りそうに思います。
 　　実際は　５列おきに入れたい文字がある　とか。
 　　でしたらまた、話は変わってきます。

 ＞第２方法をとろうとおもうのですが、
 こちらを参考に、マクロの記録を行って下さい。
 記録する動作は、「１行目を挿入」です。
 ワークシート上で、行を挿入する操作はお分かりですよね？
https://www.excel.studio-kazu.jp/lib/e4b/e4b.html
 出来ましたら、記録されたコードをこちらへ載せて下さい。

 (HANA)

 いつも早速の助言　ご教授ありがとうございました。
 ＞ 1行目の他の列には入れないってことですか・・・？
 はい　そうです。　クレジットのようなメモ書きです。一列目に書けば　他の列が空白なので　
 そのまま　重ねて表示されることを期待しています。

 やっと　「マクロ（コードとして)の記録」が わかったようです。
 実際のシートで　一行目の挿入操作を行ったことを　マクロコードとして得る　方法と理解しました。
 早速　やってみます。はい　出来上がったら　ここに載せます。
 ありがとうございます。

 ＞そのまま　重ねて表示されることを期待しています。
 .Cells.ClearContents
 で、全セルの内容を削除しているので　これは出来ません。

 1行目は削除しないコードにするか
 最後にD1セルに「xxxxxメモxxxxx」の文字を入れる
 か、どちらかお好きな方を選んで
 コードを変更してもらえば良いと思います。

 ＞実際のシートで　一行目の挿入操作を行ったことを　マクロコードとして得る　方法と理解しました。
 そうです。
 行挿入のコードなんて、私は覚えていません。

 (HANA)

ありがとうございます

Aの方法

 やっと　あたらしいマクロの記録　によって
 以下のコードを入手しました

  Sub sonyu()
 '
 ' sonyu Macro
 ' マクロ記録日 : 2009/7/16  ユーザー名 : Owner 始め[1]に1行を挿入
 '

 '
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
 End Sub

 Sub sonyuMoji()
 '
 ' sonyuMoji Macro
 ' マクロ記録日 : 2009/7/16  ユーザー名 : Owner 始め[1]に1行を挿入し、文字を書き込む
 '

 '
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "ここに文字をいれる"
    ActiveCell.Characters(4, 2).PhoneticCharacters = "モジ"
    Range("D2").Select
 End Sub

 Sub sonyuMoji2()
 '
 ' sonyuMoji2 Macro
 ' マクロ記録日 : 2009/7/16  ユーザー名 : Owner 文字を挿入する
 '

 '
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "ここに文字を挿入してください"
    ActiveCell.Characters(4, 2).PhoneticCharacters = "モジ"
    ActiveCell.Characters(7, 2).PhoneticCharacters = "ソウニュウ"
    Range("D2").Select
 End Sub

 文字を書き込んだ後　EnterKeyを押すのですが　それでよいでしょうか？
 漢字を使うと　そのコードが出来ているのでしょうか。
 さて　これの内　最後を既成のコードにはどこにいれるのでしょうか？

 Bの方法
 ＞最後にD1セルに「xxxxxメモxxxxx」の文字を入れる
 これは　上の方法で一行挿入をするのではなく、　
 ＞ 書き出し部分の、A1,D1,C1（D1は2箇所）の４か所を A2,D2,C2　に変更し
 一行挿入する（全体を一行下にづらす）方法において 行うことでしょうか？
 その場合　
    x(1, 1) = "xxxxxメモxxxxx"
 のコードが使えるとして　どこに置くとよいでしょうか？
 もし　このように、最後にD1セルに「xxxxxメモxxxxx」の文字を入れる
 ことが出来れば　そのようにしたい。

 教わるたびに　小生の方針が変わるようですみません。（簡単な方法の理解が変わるので。言い訳です)

 よろしく　おねがいします

Aの方法

 モジュールへ最後に
 Private Sub sonyuMoji2()
 略
 End Sub
 のコードに入れました。
 そして　
 With Sheets("系譜図")
    .Cells.ClearContents

    .Range("A1").Resize(UBound(y, 1), 3) = y
    .Range("D1").Resize(UBound(y, 1), xc + 3) = x  ' C列に西暦を入れるため　空けた
    .Range("C1").Resize(UBound(y, 1), 1).Copy .Range("D1").Cells(1, xc + 5)  '右端に西暦
    .Range("A1").Resize(UBound(y, 1), 1).Copy .Range("D1").Cells(1, xc + 6)  '右端に年号
    .Range("B1").Resize(UBound(y, 1), 1).Copy .Range("D1").Cells(1, xc + 7)  '右端に和暦
    Call sonyuMoji2
 End With

なるほど　これで　一行挿入され　そこへ　既定の文字列が書き込まれました。
この方法は満足です。

Bの方法については　なかなかできません。ご指導おねがいします。　はんにゃ

 マクロの記録は、簡単にコードを作成してくれますが
 不要な部も多く含まれています。

 例えば、1行目を挿入しようと思ったら、どうしても
 １．1行目を選択
 ２．行を挿入
 という手順になりますので
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
 のコードになりますが、実際に行いたいことは
 「1行目を挿入する」であって
 「1行目を選択し、選択した行を挿入する」ではありません。

 出来たコードの .Select が「を選択し」で
 Selection.　が「選択した行を」に当たります。
 ここは実際に行いたいことに含まれませんので削除します。
    Rows("1:1").Insert Shift:=xlDown

 その下で記録した、D1セルに文字を入れる部分も同様です。
 記録されたコードのうち、本当に必要な部分がどこなのか
 削除したり、くっつけたりしながら見極めて下さい。

 また、セルに文字を入れるのは　マクロの中でも基本の部類だと思います。
 Web上で、簡単な　マクロの入門ページを探して　読んで下さい。

 ちなみに、何度も書きますが
 ＞x(1, 1) = "xxxxxメモxxxxx"
 これは、変数に文字列を入れているのであって、セルに入れているわけではありません。

 ＞＞1行目から書き出しているのを2行目から書き出すのでは駄目ですか？
 ＞これをお願いします。
 というお言葉があっての、現在になります。

 つまり
 ＞x(1, 1) = "xxxxxメモxxxxx"
 をするためには、これまでの方法ではなく
 違う方法をとる必要があります。

 配列変数がわかるようになれば、そう難しい事ではないと思いますので
 スキルアップした暁に、ご自身で実装して頂ければと思います。

 現在の流れを引き継いでの操作については
 もう少し続けることは構わないと思いますが？

 (HANA)

 叱咤激励されたのに　はやばやと助けを求める不甲斐なさ

 配列（tbl1、x(xr, xc) など）と　セルとの区別がわかったようです。配列で内容を決めても、セルで の表示されるとは別である。

 現況は　
 A案
 http://www.mediafire.com/download.php?nzege4z5inz
 B案 revised
 http://www.mediafire.com/download.php?nykmyojykjy

 A 案は以下

 With Sheets("系譜図")
     .Cells.ClearContents
     .Range("A1").Resize(UBound(y, 1), 3) = y
     .Range("D1").Resize(UBound(y, 1), xc + 3) = x  ' C列に西暦を入れるため　空けた

     '　1行をメモ用に空けるため、一行目から系譜図を描いた後で　一行下へずらす場合。
     .Range("C1").Resize(UBound(y, 1), 1).Copy .Range("D1").Cells(1, xc + 5)  '右端に西暦
     .Range("A1").Resize(UBound(y, 1), 1).Copy .Range("D1").Cells(1, xc + 6)  '右端に年号
     .Range("B1").Resize(UBound(y, 1), 1).Copy .Range("D1").Cells(1, xc + 7)  '右端に和暦

     '　1行をメモ用に空けるため、直接　下へずらして　2行目から系譜図を描く場合。
     '.Range("A2").Resize(UBound(y, 1), 3) = y   'A2から系譜図 以下1⇒２へ
     '.Range("D2").Resize(UBound(y, 1), xc + 3) = x  ' C列に西暦を入れるため　空けた
     '.Range("C2").Resize(UBound(y, 1), 1).Copy .Range("D2").Cells(1, xc + 5)  '右端に西暦
     '.Range("A2").Resize(UBound(y, 1), 1).Copy .Range("D2").Cells(1, xc + 6)  '右端に年号
     '.Range("B2").Resize(UBound(y, 1), 1).Copy .Range("D2").Cells(1, xc + 7)  '右端に和暦

      Rows("1:1").Insert Shift:=xlDown    ' 直接書き込んだ線や色指定などが一緒に下にずれないの で　これはまずい。

     Range("D1") = "ここに作成氏名を書込んでください 謹製,the orginal form desingned by Teruo Nagata, and then the Excel produced by Shojiro Nagata thanks of Mr.HANA"""

     Range("Q120").Font.color = RGB(255, 0, 0)　' Test 指定のセルの文字色を決めるコード

  End With

 これを　データ変化後　再実行すると　直接セルに色づけ描画しても、コードでセルとして内容や色な どを決めていないと　それら色づけセルは　元のセルより１行したにずれることになる。元に文字の色が 元に変わる。名前に色をつける。
 そこで　Range("Q120").Font.color = RGB(255, 0, 0)　とすると　文字と対応する。実際には各セル内の"△"や"▼"で決めることになる。（後日コード作業）

 しかし、系譜図結果に追加するのは　婚姻で離れた系譜線の同一人と示す　線である。これは　どうするかメドが立たない。困難ではないだろか？

 すると　一度描画したもの（最古年を第一行）を、一行づらすのではなく、始から　最古年を第２行として　描画する必要があるようです。
　
 そこで　戻って　B案を採用しました。これで　色や線位置が変わらずになります。

 残った課題は
 A1,B1,C1に最古のデータが残ることです。これは最後に
 Range("A1：C1") = "”
 として　クリヤーするのがスマートでしょか？
 そして、  
 各セル内の"△"や"▼"の判定は　配列でできるのですが、セルと対応しないので
 改めて　セルで判定するのでしょうが　
 If Range("A1：C1") = "△" then 
 の　ようなコードでしょうか　夫婦のところで別々に名前に色づけはどうするのでしょうか？
 これを　全セルをまわさないといけない。どうするのだろう。

 ＞そこで　戻って　B案を採用しました。
 どんなコードにしたのかわかりませんが
 ＞残った課題は
 ＞A1,B1,C1に最古のデータが残ることです。
 .Cells.ClearContents
 をしていれば、データが【残る】なんてことは
 無いと思いますが？

 ＞各セル内の"△"や"▼"の判定は　配列でできるのですが、セルと対応しないので
 急にそんなことを言われても、
 なんの事やらさっぱりわかりません。

 フォントの色を変えるのは、セルの書式設定です。
 「xを書き出す前に、xにその設定をしておいて
 　データを書き出すと同時に　書式設定も・・・」
 なんて考えておられるのなら、それはできません。

 しかも、現在扱っているサンプルはかなり大きいですので
 そのあたりは、小さいサンプルで　テストコードを作成し
 納得のいくコードを作られてから
 年表系譜作成マクロに組み込んでいくのが良いと思いますよ。

 　　・・・と言うか、私はこれを
 　　　「はんにゃさんの新たな思いつき」
 　　と認識します。

 当初の段階で、はんにゃさんが　どれだけマクロのスキルを
 持っておられたのか分かりませんが、ここまでの間で
 飛躍的に向上しておられるのではないかと思います。

 しかし、いきなりこれらから入ったため
 非常に基本的な部分が未収得なのではないかとも思います。

 あ・・・ひとつ忘れるところでした。
 書式をマクロで変更するなら、「ClearContents」ではなく
 「Clear」するのが良いでしょう。

 (HANA)

 このスレでもなさっている事に今気づきましたが。。。
 どうしても変更する必要がある場合を除き
 タイトルは当初のものをそのまま使用していただければと思います。

 私は、スレはタイトルで認識していますし
 （認識の方は、割と曖昧ですので似ていれば
 　変わっていることに気づかない事が多いですが）
 テストファイル等もタイトルで管理していますので。
 （こんな感じで、データで残っていると　そのものを検索するので
 　引っ掛からなくなってしまいます。）

 (HANA)

 ありがとうございます
 B案は
 　With Sheets("系譜図")
    .Cells.ClearContents
   　'　1行をメモ用に空けるため、直接下へずらして　2行目から系譜図を描く場合。
    .Range("A2").Resize(UBound(y, 1), 3) = y   'A2から系譜図 以下1⇒２へ
    .Range("D2").Resize(UBound(y, 1), xc + 3) = x  ' C列に西暦を入れるため　空けた
    .Range("C2").Resize(UBound(y, 1), 1).Copy .Range("D2").Cells(1, xc + 5)  '右端に西暦
    .Range("A2").Resize(UBound(y, 1), 1).Copy .Range("D2").Cells(1, xc + 6)  '右端に年号
    .Range("B2").Resize(UBound(y, 1), 1).Copy .Range("D2").Cells(1, xc + 7)  '右端に和暦

    Range("D1") = "    ここに作成氏名を書込んでください 謹製"

 End With
 です。
 　結果は　OKでした。コードのミスがありました。わずらわしました。

 色づけは確かに　手作業でやっていたのをコード化するのは　小生の「新たな思いつき」です。
 はい　これは別途とします。

 多分
    .Range("A2").Resize(UBound(y, 1), 3) = y   'A2から系譜図 以下1⇒２へ
    .Range("D2").Resize(UBound(y, 1), xc + 3) = x  ' C列に西暦を入れるため　空けた
 この2行で　データを書き出すして、その後でしか　色などセルの書式設定はできない。すなわち　With Sheets("系譜図")以前では出来ない。
 と理解しました。理解は良いでしょうか？

 たしかに　その後で　
    'Range("Q120").Font.color = RGB(255, 0, 0) '各セル内の"△"や"▼"で決めることになる（後日   コード作業）などで所定の色にできました。
 ここで　全セルについて　条件で色づけすることでしょう。　勉強しながら　やってみます。
 行き止まったら　どうか　よろしく　おねがいします。そのときは　別スレッドで。

 今回のスレッドタイトルは　改題のままでよいでしょうか　それとも以前の元にもどしたら　よいでしょうか？

 ＞With Sheets("系譜図")以前では出来ない。
 ＞と理解しました。理解は良いでしょうか？

 セルにデータが入っている事と、セルの書式を変更する事は
 別の問題として考えるのが良いと思います。

 例えば、A1セルにデータが入っていなくても
 A1セルの書式は変更出来ますね？

 同じ「文字色変更」と言ってもA1セルに「りんご＝みかん」と入る時に
 "りんご"は赤に、"みかん"はオレンジに
 と言う変更は、A1セルにデータが入っていないと出来ません。

 　　それを踏まえて「・・・と理解しました。」と言う事で有れば
 　　理解は良い　と思います。

 一つのセルの中の文字の色をいくつかに変更する場合は
 （当然ですが）何文字目から何文字目を何色　と言った感じで指定をします。
 A1セルに「りんご＝みかん」が入力されると決まった段階で
 　　（＝ x(1,1)に　りんご＝みかん　と入った段階で）
 A1セルの文字色は　１～３赤、５～８オレンジ　と決まります。
 実際に文字色を変更するのは、書き出した後ですね。
 そのセルが一色で良いなら、この段階で（書き出す前でも）
 セルに書式の設定まで出来ますが。
 （しかも　文字数を数える必要も無く　出来ますね。）

 「思いつかれるたびにコードを変更するのは嫌だ」と言うのは
 確かに大変なのですが、それよりも
 「先に分かっていたら、違う設計をした」と言う部分が
 たくさん出てくるからです。

 今回の色の変更に関してもそうです。
 実際にコードを作るか作らないかは別として
 （これまでも　コードが面倒だから要望は反映しません　と言う事を
 　何度か言ってきたと思います。）
 先にそのご要望が出ていたら　又違う設計をしていたと思います。

 現在　父母（夫妻）を一つのセルに書き出していますね。
 だから、○○文字までは△色、××文字からは◇色　なんて
 面倒な設定が必要になってきます。
 もしも子の様に、一セルに一人の名前を書くことにしていたら
 変数xへ入るデータが決まった段階で、簡単に書式が決まりますし
 タイミングを気にせずセルの書式の変更が出来るように成ります。
 現在必要と思われる作業も不要に成る部分が出てきます。
 これは、コードが短くも成りますし　場合によっては
 全体の処理速度も速くなるのではないかと思います。

 子や「｜」セルの書式の変更は、簡単に出来ると思います。
 問題は　父母の場合です。
 性別を確認すると共に、子の時は不要な
 人名の長さ＋「故」の有無の確認　等
 が、左側に来ている人に関して必要です。

 私が現在のコードのままで作るなら、もう一つ変数を使って
 各セルがどの様な書式に成るのか、メモ書きをしておいて
 最後にその変数のデータを見ながら　書式を変更して行くと思います。

 しかし、実際の事を考えると　諦めて　現在完成しているコードの方を
 父と母の名前を別セルに書き出すように変更すると思いますよ。
 （書式メモの作成コードもつけくわえながら。）

 それが有るので余計に、現在出来ている状態から手を加えて・・・
 と言う発想は、面倒に思います。
 （と言う発想が無いなら、特に疑問はないのかもしれませんが。
 　やってやれない事はないので。）

 最初の設計って大切ですよ。
 ですから、面倒でも一度手作業で作成しておくのが良いと思うのです。
 コードが完成してから、コードに手を加えて行くより
 結果的には早く完成するのではないかと思いますし
 コード全体を見た時にも、よりスマートな物が出来ると思います。

 また、セルへのアクセスは時間がかかります。
 もしも「｜」も含め一セルずつ変更する事を
 考えて居られるなら　さらに時間がかかるでしょう。
 ですから、その点も考慮が必要な部分に成ってくると思います。

 ＞今回のスレッドタイトルは　改題のままでよいでしょうか
 次回から気をつけていただければと思います。

 タイトルそのものを検索した時に引っかからなく成ると言うだけで
 消されてしまったのでない限り、多くの場合
 単語や内容、ニックネーム等で検索して見つける事は出来ますので。
 （それが面倒なので、変えないでもらいたいと　思っているだけです。）

 (HANA)

 ありがとうございます
 設計・仕様が始めから提示してないために　せっかくの助言で
 （HANAさんの本領を発揮できず）
 スマートなコードが得られないことはこころから　謝ります。

 セルの文字内容を定めるコードのところを色指定の補足すればと安易に考えていました。
 でも　ひとつは内容を定めたのは　セル用の配列の内容で　セルそのものでない。
 となると　セルの番地はX,Yの座標数値でなく、A3の如く　文字名になっているので
 For　Looｐのような記述で　２・１～列・行変動最大数値を廻して、各セルの性記号の三角印との
 照合で　該当セルの色を変更するという　安易なもくろみがきえました。
 セル名が文字で　どうやって　セルを廻してできるのか　勉強しなければ　なりません。

 For　XXX to Max  'Looｐ この記述を勉強しないといけない
  if Range(x, y) = Like "*[▼]*" Then "Range(x, y) =" .Font.color = RGB(255, 0, 0) 
 　else 
  　if Range(x, y) = Like "*[△]*" Then "Range(x, y) =" .Font.color = RGB(0, 0, 255)
 　else 
 　"Range(x, y) =" .Font.color = RGB(0, 0, 0)

 Next

 子のときの
 > 　そのセルが一色で良いなら、この段階で（書き出す前でも） セルに書式の設定まで 出来ます。

 この段階というのは　With Sheets("系譜図")の前、即ち　For i = 2 To UBound(tbl1, 1)　
 の中ででしょうか
 これが可能なら　それをめざしたい。
 理解不足？　ここでは配列しか操作していないから　セル操作はできるだろうか？

 >  変数xへ入るデータが決まった段階で、簡単に書式が決まります

 うーむ！？　ということは　配列値を決めるときに　同時にコード化できるということでしょうか？

 同じセル内で　父母の２つの名があって　それをそれぞれ色わけするには　＝＝＝の前の文字数、
 後の文字数を数え　それぞれの文字数を
 色別に指定ということだと理解しました。小生にはむずかしい。（手操作では　出来ます）。
 別のセルを使うにして　左（先出）名前の字数で右（後出）の名前のセル位置を変える　
 ということも出来そうですが
 結構むずかしそう。

 当面、子の文字に限って色別指定をめざします。

 また　系譜線｜は　最後系統の家族から　逆に遡って辿るときは男系、女系の色が決まりますが、
 両親からは　娘あるいは息子の両方があるので一概にどの色ときめられないので自動化はしません。

 なお　助言を求める前に　1番　考えたことは　　
 配線図のごとく　交差しないように　決めるということでした。

 頭の中で論理的であれば　パソコンに命令（プログラム）することは　半ば出来上がったようなものだそうですが。
 実際には　次々といろんなケース（特に昔のひと）が出て、プログラムなかせでした （自力でなく、
助言にしたがって作った）

 今は親子組を一つの系譜線であらわして　両親ー子の系譜線が一組ですが
 子が次の世代（家族）を成すと　データとして　もう一組作ることになる。
 作図でも　カット＆ペーストの作業がいる。

 交差しない条件があったり、書き方をうまく見つけられれば　（一代なら　年少者の系 譜線を最左にして　
 次の年長者のをより右に描くという決め方）子の結婚（＝親に成る）と、次々と系譜線を階段式に
 描かれるが、子が複数となると　次の子らの系譜線はどうするかで　なかなか論理的な配置が難しい。
 本人から見て　おいやめい（いとこ同士）が並ぶ　系譜線が何本もあると交差することになる。

 これは難しかったので　親子関係で一系譜線をかくことにしました。
 それ以外は不明なデータなどを良く考えなかったというのが実情です。

 手操作でやって　そのマクロへの記録を参照しながら　勉強していきます。
 ありがとうございました。

 ここまでやってきて「いまさら」と思われるかもしれませんが
 もう一度【入門】から始めていただくのが、良いと思います。

 知っていることだけでも　VBAですから
 いろいろ組み合わせて乗り越えることは出来ると思います。

 しかし、いろいろ組み合わせずに出来る方法があるのなら
 それを使わない手はありません。

 たとえば、B5セルをマクロで表すには
 Range("B5")の様に書きますが
 Cells(5 , 2) と言った書き方もできます。

 今回、x(1,1)は Range("D2") に書き出すので
 Cells(2 , 4) に対応します。　 　↓xの行列
 xの行+1 が　セルの行番号で　　（１ +1= ２）
 xの列+3 が　セルの列番号です。（１ +3= ４）
　　　　　　　　　　　　　　　　　　　　↑Cellsの行列
 ですので
                    If tbl1(i, 6) Like "*[息子]*" Then
                        sb = "△"
                    ElseIf tbl1(i, 6) Like "*[娘]*" Then
                        sb = "▼"
                    Else    '関係が無記載
                        sb = "◎"
                    End If
 この判定で、文字色が決まり
                    x(xr, xc + 2) = sb & knm(tbl1(i, 9), tbl1(i, 1))
 この x(xr, xc + 2) で、セル番地が決まります。
 Cells(xr + 1 ,xc + 2 + 3)　　xr + 1行目 で xc + 5列目のセル

 また、必ず先頭一文字で判断すればよいので
 Range(x, y) = Like "*[▼]*"　よりも
 LEFT(Cells(y,x),1)="▼" の方が良いかもしれません。

 それから、
 ＞ For　XXX to Max  'Looｐ この記述を勉強しないといけない
 このコードでは、たとえ完成したとしても
 時間ばかりかかって使い物にならないと思いますよ。

 ＞当面、子の文字に限って色別指定をめざします。
 ＞また　系譜線｜は　・・・　自動化はしません。
 この部分をもう少し考えてから、コード作成に
 とりかかるのが良いのではないかと思います。

 たとえば、▽▼以外の時に文字色を黒くするなら
 「｜」のセルは黒くなりますね。
 それは困るので「｜」の時は変更しない事にする場合
 その前の時に「▼」だったけど今回「｜」になったセルは
 文字色が赤いままで残ります。
 たとえその列の系譜線の色が青だったとしても。
 それでは、最初にすべて黒にリセットしたら？
 せっかく手動でつけた「｜」の色が無くなってしまいます。

 データは追加のみで、変更がないのなら
 心配する様な事でもないかもしれませんが、
 家族ごとの場所替えなど、考えられる事だと思います。

 結局今回使えないことになっても
 今後何かの役に立つだろうからそれでも良い
 というお考えであれば、頑張っていただければ良いと思いますが。

 (HANA)

 なるほど　セルを　　
 > Range("B5")の様に書きますが, Cells(5 , 2) と言った

 行列値も出来るのですね
 （こんな入門事項をしらないで、すっかり手ほどきを受け　恐れ入ります）

 はい　
  For i = 2 To UBound(tbl1, 1)
 の　中で　"△""▼"の判定の後、文字内容を決めたときに　各セルの書式も同時に変更できそうです。

 x(xr, xc + 2) = sb & knm(tbl1(i, 9), tbl1(i, 1))
 If LEFT(Cells(xr + 1 ,xc + 2 + 3),1)="△"　Then
　　  Cells(xr + 1 ,xc + 2 + 3).Font.color = RGB(0,0,255)
 ElseIf LEFT(Cells(xr + 1 ,xc + 2 + 3),1)="▼"　Then
      Cells(xr + 1 ,xc + 2 + 3).Font.color = RGB(255, 0, 0) 
 End IF

 まだ間違っている不安あり。
 この記述でのセルはデータ表でのセルを指すのか、それとも系譜図でのセルを指すのか　？
 もし前者なら　コードは間違いです。そして　With Sheets("系譜図")の中でする必要があると思われるのですが、その場合　全セルでの判定は For によるコードは　
 >時間ばかりかかって使い物にならないと思いますよ。
 となると　どうするかわからなくなりました。

 それと　手で修正された｜線もデータ修正後の再実行で　元に戻るのは　まずいので
 言われるように　変更しないと良いか考えます。
 上のコードで変更しないことになっているでしょうか？

 まだ　試行してみていません（すみません　腰の痛みが限界なので　ひとまず　お礼の返事を先に）
 やってまた報告したいと思います。

 ありがとうございました。

 すでにあるコードの一部を変更するのは
 （今までやられた様な事であれば）
 VBAの知識がほとんどなくても、想像力で
 出来ると思います。

 しかし、コードを作るとなると
 （それがたとえ、コピペの寄せ集めとしても）
 そうは行きません。

 何度も書きますが、基本からもう一度始めてください。

 ＞この記述でのセルはデータ表でのセルを指すのか、それとも系譜図でのセルを指すのか　？
 どのシートに対する処理なのか、書いてない場合は
 アクティブシートに対して処理されます。

 また、書いておられる

  x(xr, xc + 2) = sb & knm(tbl1(i, 9), tbl1(i, 1))
 If LEFT(Cells(xr + 1 ,xc + 2 + 3),1)="△"　Then
　　  Cells(xr + 1 ,xc + 2 + 3).Font.color = RGB(0,0,255)
 ElseIf LEFT(Cells(xr + 1 ,xc + 2 + 3),1)="▼"　Then
      Cells(xr + 1 ,xc + 2 + 3).Font.color = RGB(255, 0, 0) 
 End IF

 このコードは希望する結果は得られません。
 良い条件が整っていれば、動かしたとき
 思ったような結果になったと思われるかもしれませんが
 もしもそうだとしても、それはたまたまです。

 面倒だと思われるかもしれませんが
 ご自身でコードを作成しようと思われるのでしたら
 いきなり現在の課題やコードに手をつけるのではなく
 小さなテストデータを作って試行してください。

 小さなテストデータとは、
 　●コードで、セルの文字色を変更してみる
 これは勿論ですが
 　●配列に△や▼が入っている状態から　判定し
 　　セルの文字色を所定の色に変更する
 です。

 現在できているコードでは、配列のどこに△や▼が入っているか
 はんにゃさんご自身で判断するすら難しい状態だと思います。
 （確かに、配列に△や▼が入っているのですが。。。）

 ですから、その様な不明な部分が多いデータを使うのではなく
 確定しているデータを作り、そのデータを使って
 サンプルコードを作って下さい。
 自分で作ったデータであれば、
 「ここの△を▼に変更してもう一度動かしてみよう」
 「ここに▼があったけど、これをなくして動かしてみよう」
 等も、やりやすくなると思います。

 そして、現在のコードに手を加える場合は
 もう少し流れをつかんでからにしていただきたいと思います。

 (HANA)

ありがとうございます

はい、短いものをつくる　マクロへの記録を参照する
などしてみます　

 助言頂いたように　きちんと　基本を勉強、流れをつかむことがまだまだ不十分とは思いつつ、
 Helpや小マクロ記録などで　試行しつつ（傲慢ながら）　本件のマクロを修正しました。

 http://www.mediafire.com/download.php?emmzgyt2mdc

 いくつかの（実際印刷することを考えると　無駄のない列幅の調整などは　ルール化が難しい）問題などがあるし、
 これまでのように　期待されるような　入力状態（例えば　年子が連続したときの生年の記載）でない場合には結構問題が出てくるでしょう

 HANAさんにはほとんど教えて頂き本当に感謝します。
 ご推察のように　小生ほとんどスキルはありません。
 Cells　配列の表現など　本校の検索でも　Helpではほとんど見つけられなかった重要な表現など　教えて頂きました。

 腰もどんどん痛くなるので　一先ず　満足して　この件は感謝で閉じます

 みなさま　今後とも　よろしく　ご指導　ご鞭撻ください
 もし　どなたか　つかってみて　良い改善策などがありましたら　ご提案歓迎で　幸甚
(はんにゃ)

 ＞もう少し流れをつかんでからにしていただきたいと思います。
 と書いたのは、子の文字色を決める時に
 「If LEFT(Cells(xr + 1 ,xc + 2 + 3),1)="△"　Then」
 （或いは、変数xの中の先頭文字を確認して）　ではなく
 最後に載せておられるサンプルでやっておられるように
 「If sb = "▼" Then」と
 sbの値を確認するのが良いと思っていたからです。

 この点につきましては、流れを充分つかんでいただいていると思います。

 気になる点は、
 「Sheet2.Cells(xr + 1, xc + 3).Font.color・・・」
 の様に、シートを指定する際に　コードネームを使用している点です。
 例えば、現在の「系譜図」シートを一旦削除し
 　（データの削除　ではなく、シートの削除　の事です。）
 別のシートの名前を「系譜図」としても、シートの名前しか変わりませんので
 Sheet2が見つからず、マクロはエラーを出すと思います。

 理屈は抜きでまず変更するなら
 書き出し部分の先頭にある
 「With Sheets("系譜図")」
 を、
 「xc = 2 '作図の左端D列から」
 あたりの良い位置へ持っていって、コードはSheet2の6文字を削除。
 「Sheet2.Cells(xr + 1, xc + 3).Font.color・・・」
   ~~~~~~≪注≫Cellsの前の . は残して
 「.Cells(xr + 1, xc + 3).Font.color・・・」
 として下さい。

 以下、少しだけ理屈ですが

 Cellsの前に何もない場合は、アクティブシートのセルを表します。
 しかし、With Sheets("シート名") ～ End With　の間にあるコードのうち
 .Cells となっている場合（. がある場合）は
 Sheets("シート名").Cells と書いた場合の「Sheets("シート名")」が
 省略されているとみなされます。

 つまり、「With Sheets("系譜図")」を上に持ってきて
 その下に.Cells とあれば、これは
 Sheets("系譜図").Cells と書いてあるとみなされ
 系譜図シートのセルを表すようになります。

 非常に大雑把な説明ですので、詳しくは
 ヘルプ等　確認してみて頂ければと思います。

 ＞本校の検索でも　Helpではほとんど見つけられなかった重要な表現など
 これはたぶん、たくさんありすぎて見つからなかったか
 検索ワードが悪くて見つからなかったか
 見ているけど、違うものだと思っているのか・・・・
 だと思います。

 そんなに変な事はしていないと思いますので。。。。

 　　ちなみに、最初からセル番地の行列番号を絡めると分かっていたなら
 　　変数xは　x(1,1) をA1セルの位置にしていたと思います。
 　　すると、xの行列番号が単純にセルの行列番号と一致します。
 　　（もちろん、D2セルを基準に（A1セルとみなして）、○行×列のセル
 　　　と言った書き方にして、行列番号と一致させる方法もあると思いますが。。。）

 閑話休題・・・。

 はんにゃさんがなさろうとして居られる事は
 「あるコードの意味と使い方を知る」と言う事ではなく
 「ある処理をする為のより良い方法を知る」と言う事だと思います。

 前者であれば、ヘルプを見るのが第一だと思いますが
 後者であれば、一つの事をするのに、どの様な処理方法があるか
 知る必要があると思います。

 そこで、入門ページが役に立つと思います。
 入門ページは多くの場合、同じ様な事は同じグループに分類されていますし
 実際に動かせるコードと、元データ・結果図　を
 あわせて載せてある所が多いと思います。

 そして、私は　はんにゃさんの場合
 「まずは目を通す」をしてもらえれば
 良いのではないかと思っています。

 本来は、次のページへ移る前に理解しなくてはいけないのかもしれませんが
 はんにゃさんの場合
「この様な場合は、この様に出来て、そのサンプルコードがここにある」
 という事を、知っておいてもらえれば　実際に事にあったった時に
 そのページへ立ち戻ることが出来ると思っていますので。

 入門ページに目を通してもらったら、
 実践（学校内や、他の質問掲示板など）で
 色々な人がどのような処理をしているのか見て
 処理方法をストックしていくのが良いと思います。

 入門ページから一歩（何歩も？）入った解釈での
 色々な処理に出会えると思います。

 結局長くなってしまいましたが。。。
 私は良く（今でも）このページにお世話になっています。
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/index.html
 多くの場合、Google先生の斡旋ですが。

 早急である必要はないと思います。
 ゆっくりとでも　はんにゃさんの更なる進化を期待しています。
 お体にお気をつけて、程好い程度で　頑張ってください。

 (HANA)

更なる　ご指導ありがとうございます

 ＞気になる点は、
 ＞「Sheet2.Cells(xr + 1, xc + 3).Font.color・・・」
 ＞略
 ＞ 「With Sheets("系譜図")」
 ＞略
 　なるほど。これで働きました。　
 　このSheet2をつけることは　データ表を見ながら　
 実行したら　データ表でなにか変わったので　そのシートを指定しないといけないと
 理解して　記載しました。
 Sheets"名"と既定のSheet番号とは必ずしも対応しないということをしりました。
 またまた　感謝。

 ＞  検索ワードが悪くて見つからなかったか
 　そうです。用語がちんぷんかんぷんです。まったくの例えですが、
 数学の式で 四則演算以外の記号はほとんどわからない小生に　
 こういう式ですと　解答されても　さて　
 どうした四則演算の手順で計算するのか　皆目検討が付かないのと同じ状態です

 ＞ちなみに、最初からセル番地の行列番号を絡めると分かっていたなら
   　　変数xは　x(1,1) をA1セルの位置にしていたと思います。
  　　すると、xの行列番号が単純にセルの行列番号と一致します。
 　
 　はい、途中での仕様を変えて　すみませんでした。
 　これなど　うれしい限りのはずでした。一度は　ｘ（ｘｒ、ｘｃ）のときの　Cells（ｍ、ｎ）の、
 　ｍ＝ｘｒ＋１、ｎ＝ｘｒ＋３を挿入して　と思ったほどでした。

  ＞（もちろん、D2セルを基準に（A1セルとみなして）、○行×列のセル
  　と言った書き方にして、行列番号と一致させる方法もあると思いますが。）
 　０やマイナスの配列値は取れないから　どうするのでしょう？

  ＞ はんにゃさんがなさろうとして居られる事は
 「あるコードの意味と使い方を知る」と言う事ではなく
 「ある処理をする為のより良い方法を知る」と言う事だと思います。

 　いや　”より良い”方法など選択出来ることではなく、
 ”ある処理をするコード（関数？記述表現）を 知る”という初歩のことでした。
 それを　部分と全体併せて　こんなに教えて頂き、ありがとうございます。

 http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/index.html
 など　参考にしつつ　せっかくのものを”闇雲に　でっこく”して　壊さないように
 （よくやってしまう苦い経験多）　すこしづつ　より見やすい　使いやすいものへ
 手直していきたいとおもっています。
 今は　手操作での列幅調整を可能な限りソフト化しようとしています。
 現行は
    .Cells(1, xc + 3).ColumnWidth = 10.5 '　前者親名列の幅
 '.Cells(1, xc + 3).Columns.AutoFit ' 幅の最適化　文字が既に入った条件でない
 　や
     .Cells(xc + 5).ColumnWidth = 10.5  '最後の名前列の幅
     .Cells(xc + 8).ColumnWidth = 4.5  '西暦年列の幅
 　の固定ですが

    'now not working
    'For i = 2 To xc Step 5
    '.Cells(i).Columns.AutoFit ' 幅の最適化　全行を掃引するか？
    'Next
 のような　Len関数で列内全セルの最大文字数にあわせるとか
 最適化のコードがないかと調べ　考えていますが　難しいです。
　
 それと　生年等不明のばあい　最古年にしているコードがわからず
 目をさらにして　”眺めて”いますが、　今一歩か数歩離れている
 Call snsr(tbl1, nn, totbl, erf)  ' nn 最古年などを決める
 Private Sub snsr(tbl1, nn, totbl, erf)

 fyi = psn(nn, p1(2), p2(2))  '前者生年、後者生年
 Private Function psn(nn, fys, mys)  '前者生年、後者生年不明の場合の年を決める

 などと思うのですが

 ＃筆では　手が振るえる年（？）ですので　パソコンはありがたいです。
 お気使い感謝します。

 入力が正規でない場合を相談するのは　ルール違反とは承知で
 見ていただければ幸いです

 下記のように　息子の欄に母の字があると

 始		1910.1			父
 始の妻		1920.2			母
 その長男		1922.3			息子
 次男		1924.5			息子
 三男　		1926.7			子　母　
 長女		1930.8			娘
 ４男		1934.9			息子

 結果は

		1926.7～			
△始=	X	 =▼三男　			
1910.1～

と　本来の母は（多分上書きされて）三男の名前が出てきます

 あるいは

  三男　		1926.7			子　父

 の結果は
		1926.7～			
△始=	X	 =△三男　			
1910.1～

となります。

これには　既に一度出現したか　どうかのIndexで記録して　それで回避するようにするのでしょうか？

pd(tbl1, i, sb, p1, p2) '名前、生年等のデータを整理する
するとすれば　辺りでしょうか？

    Dim ml As Long, lenc As Long    ', iml As Long
    略

    '幅の最適化　５セル毎の前者親名の各列全行を掃引　Len() で最大長の行セルで最適化　はじめはE列を期待して
    For i = 1 To xc Step 5
        ml = 1#
        For ii = 1 To UBound(y, 1)
         lenc = Len(Cells(ii, i))
         If lenc > ml Then
            ml = lenc
            'iml = ii
         End If
        Next
        '.Cells(iml, i).Columns.AutoFit ' 最適化は余裕があり過ぎ
        .Cells(i).ColumnWidth = ml
    Next

これだと　

 A      B        C      D       E       F       G
明治	42	1910		△始=	X	 =△三男

となります。
幅が変わるのはFで、Eではありません。
iの初期値を変えたのですが　これより左の列Eから　始まりません。
どこが不都合でしょうか？

 先のセル位置の問題は　For i = 5 To xc Step 5　と直し解決しました
 しかし、現在同じ列に長文字数の生年なども書き込んでいるので　幅が広すぎる
（生年行は隣列に空欄の余裕があり、重ねて表示される）
 それに　今頃気づいたのですが、幅の要る親名は　列に一つしかない
 表示の仕方なので　全行を見ての 調節は必要がなく、データの記録時に一度行えば良い。
 そこで　先のをやめて、以下を入れた。

    x(xr, xc) = p1(0) & knm(p1(3), p1(1)) & "=" '前者親名書込み
    .Cells(xc + 3).ColumnWidth = Len(x(xr, xc)) * 1.5 ' 列幅文字数適応
　　　　　　　　　　　　　　　　　　'ここを修正　Cells()では無効
    '.Cells(1, xc + 3).Columns.AutoFit ' 幅の最適化　文字が既になければならない
    '.Cells(1, xc + 3).ColumnWidth = 10.5 '列の固定幅

    x(xr, xc + 1) = "X"
    x(xr, xc + 2) = " =" & p2(0) & knm(p2(3), p2(1)) '後者親名書込み

 これで一先ず　幅調整はできました。

 後は　最大の難所（仕様変更なる）の子の一組婚姻の直系は　連続して　子（親）＝X＝で表現する
ことです。

 ぼちぼちで　行います。
 ありがとうございます。

 済みません、文章を間違えていました。

 ＞＞ はんにゃさんがなさろうとして居られる事は
 ではなく、
 「現在、はんにゃさんに必要と思う事は」でした。。。

 勿論、既に出来ているコードの分からない部分を見つけ
 「あるコードの意味と使い方を知る」と言う事
 も必要ですが、それ以上に
 「ある処理をする為のより良い方法を知る」
 これは不可欠だと思います。

 ＞いや　”より良い”方法など選択出来ることではなく、
 入門ページを見ると、シートの指定は
 Sheets("シート名")の様に行うか
 Sheets(Index番号）の様に行う方法をが書いてあり
 コードネームを使用する方法はあまり書いていないと思います。

 ですから、入門を終了していれば　手探りで試行錯誤して
 Sheet2.Cells・・・等というコードを見つけなくても
 　Withで括らないまでも
 Sheets("系譜図").Cells
 と言う書き方を思いつかれたのではないかと思います。
 （当然これも思ったけど、コードが短くなるから　コードネームを使った
 　と言うので有れば、お話になりませんが。。。）

 ＞知っていることだけでも　VBAですから
 ＞いろいろ組み合わせて乗り越えることは出来ると思います。
 と、先に書きましたが　「試行錯誤で見つけたこと」もそうなんです。
 VBEをみて「Sheet2」って書いて有るなと思って、Sheet2.Cells
 とされましたね？

 見えている物だけでも、よく見て　よく考えて　想像して・・・
 多くの事が出来るようになると思います。

 でも、先に　シートを指定するときは　この様に書く
 セルを指定するときは、この様に書く　と知っていれば
 より良い書き方を意識することなく、基本に則った書き方が
 出来るのではないかと思います。

 その辺りが、非常に残念に思うのです。
 結局希望する結果が得られるコードをご自身で作れるのですから
 とやかく言うことではないのかもしれませんが
 それでも、基本をやっておくことで　平坦で歩きやすい道が見えるのに
 それをやっていない為に、時間を掛けて　道を切り開き
 目的地にたどり着いて居られるように思います。

 現在のコードが、入門的なコードで有れば
 このコードを読み解きながら、理解を深めていって頂ければ良いと思いますが
 あまり、お手本に出来るようなコードでは有りません。

 さて、関係を入力する列に
 子　母、子　父　の様な入力をする件に関しては
Private Sub pd(tbl1, i, sb, p1, p2)
    If p1(0) = Empty Then
        p1(0) = sb: p1(1) = tbl1(i, 1): p1(2) = tbl1(i, 8): p1(3) = tbl1(i, 9)
        p1(4) = tbl1(i, 10): p1(5) = tbl1(i, 11): p1(6) = tbl1(i, 12)
    Else
        p2(0) = sb: p2(1) = tbl1(i, 1): p2(2) = tbl1(i, 8): p2(3) = tbl1(i, 9)
        p2(4) = tbl1(i, 10): p2(5) = tbl1(i, 11): p2(6) = tbl1(i, 12)
    End If
End Sub
 この部分で、Else を ElseIf p2(0) = Empty Then
 に変えてみるのはどうでしょう？

 父母の一回目に見つかった行のデータがp1に
 二回目に見つかった行のデータがp2に
 入ることに成ると思います。

 (HANA)

 ありがとうございます
 　Hannya ＞いや　”より良い”方法など選択出来ることではなく、
 これは　
 小生には　いくつもある方法から　より良いものを選べる　贅沢なことは言えない。
 コード（必要容量）が大きくなっても、一つ知ったら　それでありがたい
 という状態です
 といったつもりでした。
 Sheetの指定方法で言ったことでなく、関数とか　サブルーチン名とか　記述の仕方など全般についてです。

 はい　入門レベルを端折って　セルの関数レベルを想定していて、
 マクロなるものがで てくることを想定していなかった小生には　無謀な相談でした
 （むかし　むかし　Ｂａｓ ｉｃはいじったことがすこしあったのですが　 
 すぐつかわなくなった。これがこんなとこ ろでつかわれているのをしったのはこの件でです　
 なるほどコンパイラーをそのつど操作しない言語が活かされているのだとなっとく。）

 この系譜図も　身内がまったく線も名前も　シートに直に手操作で書き込んでいたのを見て、
 なにか表から自動化できないかとおもいついたものです

 本当にHANAさんには感謝します。はい　入門レベルをすぐというと約束違いになりますが　
 おいおい勉強します。基本の大切さを改めて教えられました。

 具体的なコードの改修については結果はのちほど　報告します
 ありがとうございました。

 再び　誤りで父/母の記載 関係者がでたときの　処理コードありがとうございました
 > 父母の一回目に見つかった行のデータがp1に 二回目に見つかった行のデータがp2に
 入ることに成ると思います。
 はい、後出が前出の父母に重なって　書き込まれることはなくなりました。
 しかし　まったく子の系譜線にも出ない　無視された結果になりました。

 今　子が　次世代の親になるのを　連続させるために　系譜図を統合、修正する統合系譜図に
 全面コピーし　その上で　子と親の同一人名（後者は＝記号が付いているので）をカット＆ペーストをしています。

 これを機会に　それを自動化するために　データの書き方を

 始		1760.1			父
 始の妻		1764.1			母
 女１		1779.2			娘
 長男		1780.1			息子
 次男		1781.1			息子
 三男　		1785.1			子 父　　
 [他嫁		1780.1			母
 長女2		1798.1			娘
 長男２		1799.1			息子

 期待する系譜図

 	9	1759				1764.1～						
 宝暦	10	1760		△始=	X	 =▼始の妻						
 	11	1761		1760.1～								
 	12	1762			｜							
 	13	1763			｜							
 明和	元年	1764			｜							
 	2	1765			｜							
 	3	1766			｜							
 	4	1767			｜							
 	5	1768			｜							
  	6	1769			｜							
 	7	1770			｜							
 	8	1771			｜							
 安永	元年	1772			｜							
 	2	1773			｜							
 	3	1774			｜							
 	4	1775			｜							
 	5	1776			｜							
  	6	1777			｜							
 	7	1778			｜	1779.2～						
  	8	1779			▼女１	1780.1～						
 	9	1780			△長男							
 天明	元年	1781			△次男							
 	2	1782			｜	1781.1～						
 	3	1783			｜							
	4	1784			｜				1780.1～		
 	5	1785			△三男　= 			X =▼[他嫁		
  	6	1786			｜	1785.1～						
 	7	1787							｜			
 	8	1788							｜			
 寛政	元年	1789							｜			
 	2	1790							｜			
 	3	1791							｜			
 	4	1792							｜			
 	5	1793							｜			
  	6	1794							｜			
 	7	1795							｜			
 	8	1796							｜			
 	9	1797							｜	1798.1～		
 寛政	10	1798							▼長女2			
 	11	1799							△長男２			
 	12	1800							｜	1799.1～		
 享和	元年	1801

 のように、系譜線の一人の子のみの婚姻を階段状に続けて書き込むように出来ないか　検討しています。
 データの書き方は　その婚姻の子は始めの系譜線の他の子の生年に関わらず　最後に記載して
 その次行に（婚姻した）片親を書き、そして　その（第2系譜線の）子らを書くということにする。
 これは家系というより、現在の子の系譜から遡って辿った直系を表すことを期待しています。
 他の子の系譜は　別に空白行のあと　婚姻関係から別の系譜線を始めます。

 データの書き方を決めた段階で　これから　処理のルールを考えて、それをコード化する予定です
 もし　助言を頂ければ幸い至極です

 ＞はい、後出が前出の父母に重なって　書き込まれることはなくなりました。
 ＞しかし　まったく子の系譜線にも出ない　無視された結果になりました。

 確かに、言われてみるとそうなりますね。
 （良く考えてから書けば良いのに。。。笑）

 ＞入門レベルをすぐというと約束違いになりますが
 この発言の真意が良くわかりませんが
 これからコードを作成（「変更」という気分なのでしょうけど）していく為には、
 もっとたくさんの事を知っておかれるのが良いと思います。

 今更何を言っても仕様がないのかもしれませんが
 私のコードは、全くの独学で　趣味の範囲です。
 内容的にも、その程度ですし

 ＞関数とか　サブルーチン名とか　記述の仕方など全般についてです。

 この部分に関しても、参考にしてもらっても良い記述方法なのか
 実際の所　セオリーから外れていて、見られたものじゃない記述方法なのか
 私自身、全く分かりません。
 （気紛れで付け足しているので、やっぱり違うんじゃないかと思います。）

 どこが参考に出来るのか、どこが参考に出来ないのか
 それを見極めてもらう為にも　入門から初めてもらう事が
 私の希望です。

 (HANA)

　
はい　この横着者を叱咤激励頂きありがとうございます

 ＞ 「変更」という気分なのでしょうけど

安直な姿勢を見透かされてしまいました。
少しづつですが　入門をかじっていきます。

いくつか読んだのですが

 .Range("C2").Resize(UBound(y, 1), 1).Copy .Range("D2").Cells(1, xc + 1)  '右端に西暦
 .Range("A2").Resize(UBound(y, 1), 1).Copy .Range("D2").Cells(1, xc + 2)  '右端に年号
 .Range("B2").Resize(UBound(y, 1), 1).Copy .Range("D2").Cells(1, xc + 3)  '右端に和暦

 .Cells(xc + 1 + 3).ColumnWidth = 4.5 '右端に西暦年列の幅
 .Cells(xc + 2 + 3).ColumnWidth = 3.75 '右端に元号
 .Cells(xc + 3 + 3).ColumnWidth = 2# '=2.0'右端に和暦
 .Range("D2").Cells(xc + 0 + 3).ColumnWidth = 10.5 '最後列の幅

 上のこぴーの目標のセルの番地(x + n)に対応する　
 同じセルの幅指定の番地が(x + n + 3)となることが
 まだ理解できないでいます。
 Range("D2").と指定しているからと思い　最後列幅のように書いたのですが
 今度はまったく無視されます。
 x(xr,xc) => cells(xr + 1,xc + 3)とのずれがあることと関係しているようですが、
 同じCellsの記述ですので不思議です。
 こんなことも入門理解不足に起因しているのですが、棘のようにひっかかっています。

 ご不明な点がどこなのかよくわかりませんが
 例えば、xcが「1」だった場合
 xc+1+3 = 5
 ですから
    Sub test1()
        MsgBox Cells(5).Address(0, 0)                   'Cells(xc + 1 + 3)
        MsgBox Range("A1").Cells(5).Address(0, 0)       'Range("A1").Cells(xc + 1 + 3)
        MsgBox Range("A1").Cells(, 5).Address(0, 0)
    End Sub
 どの様に書けば、期待するセル番地を得られるか
 確認して見られるのが良いかもしれません。

 また、
 ＞Range("D2").と指定しているからと思い
 これに関しては、問題ないと思います。
    Sub test2()
        MsgBox Range("D2").Cells(1, 1).Address(0, 0)
        MsgBox Range("A1").Cells(1, 1).Address(0, 0)
        MsgBox Cells(1, 1).Address(0, 0)
    End Sub

 (HANA)

 ありがとうございました。
 Cells(5).とか　Cells(, 5).の結果と記述を見て気づきました。
 入門以下の注意不足でした。
 Cells(1, xc + 3)  '右端に和暦
 を踏襲したつもりでしたが、まったく違ってCells(xc + 3)はコラム変数になっていなかった。

 心して注意していきます

 セルの座標（と呼ぶのか　配列名と呼ぶのか？）を以下に試してわかりました。

 Sub Cellzahyo()
         MsgBox "Cells(1, 1)=" & Cells(1, 1).Address(0, 0)   '=A1
         MsgBox "Cells(5)=" & Cells(5).Address(0, 0)                   '=E1
         MsgBox "range(A1).cells(5)=" & Range("A1").Cells(5).Address(0, 0)       '=A5
         MsgBox "Range(A1).Cells(1, 1)=" & Range("A1").Cells(1, 1).Address(0, 0) '=A1
         MsgBox "Range(A1).Cells(, 5)=" & Range("A1").Cells(, 5).Address(0, 0)   '=E1
         MsgBox "Range(D2).Cells(1, 1)=" & Range("D2").Cells(1, 1).Address(0, 0) '=D2
         MsgBox "Range(D2).Cells(1, 5)=" & Range("D2").Cells(1, 5).Address(0, 0) '=H2
         MsgBox "Range(D2).Cells(5)=" & Range("D2").Cells(5).Address(0, 0) '=D6
 End Sub

 Range("Xn")を先に記述することはOFFSeTを与える機能と理解しました。
 Cells(xc + x + 3）はRange("D2").Cells(1,xc + x)と同じと理解しました。

 面白いのは　Cells(５）のように同じ単独数のとき、'=A5　'=D6　のように基準から５行目を表す場合
 と　'=E1　と５列目を現す場合があることです。
 後者は　どうして区別するかな？
 Range("A1").が略されていると解釈しているわけではないし？？

 ＞Range("Xn")を先に記述することはOFFSeTを与える機能と理解しました。
 そうですね。今回の場合は同じ様な使用方法になっていますね。
 なので、大抵はOFFSETを使うと思います。

 ＞基準から５行目を表す場合
 ＞と　'=E1　と５列目を現す場合があることです。
 ヘルプを読んでの解釈ですので違っているかもしれません。
 一応、参考にした項目は
 「Worksheet.Cells プロパティ（Cells プロパティ）」と「Itemプロパティ」です。
 ご自身でも確認して頂ければと思います。
 　　尚、引用したヘルプは2007のものです。

 「Worksheet.Cells プロパティ」の中で使用例として

 ◇次の使用例は、シート 1 のセル C5 のフォント サイズを 14 ポイントに設定します。 
 ◇Worksheets("Sheet1").Cells(5, 3).Font.Size = 14 
 ◇
 ◇次の使用例は、シート 1 のセル 1 の数式をクリアします。 
 ◇Worksheets("Sheet1").Cells(1).ClearContents

 とあります。
 ここで気になるのは、下側のコードの説明として
 シート1のセル【A1】の数式をクリアするのではなく
 シート1のセル【１】の数式をクリアする　　と書いてある点です。

 そこで、このページをもう少し見てみると

 ◇Item プロパティは、Range オブジェクトに対する既定のプロパティであるため、
 ◇・・・・（中略）・・・・
 ◇Item プロパティの詳細ついては、Item プロパティおよび特定のコレクションでの
 ◇使用例を参照してください。

 と書いてあるので、素直に「Item プロパティ」を確認してみます。

 こちらのページの「RowIndex」の説明として

 ◇左から右に、次に上から下に数えて、アクセスするセルのインデックス番号を指定します。

 と書いてあります。

 Rowって書いてあるのだから、ここに数字が入っていたら無条件で下方向へ行きそうですが
 「左から右に」が先と書いてありますね。

 そこで気になるのがやはり
 ＞シート1のセル【１】の数式をクリアする
 です。

 １って事は、２、３、４・・・と続いて行きそうです。
 そして、左から右・上から下　です。

 そこで思ったのがこんな確認。
        MsgBox Range("A1:B3").Cells(3).Address(0, 0)
 A1が「1」
 右へ移って、B1が「2」
 もう右がないので、下へ移っての左端　A2が「3」

 実行すると、想像した結果が得られるようです。
 （7以降もセル番地を返してくれますが・・・・。）

 ＞Range("A1").が略されていると解釈しているわけではないし？？
 これに関しては、「Worksheet.Cells プロパティ」の方に

 ◇オブジェクト修飾子を指定せずにこのプロパティを使用すると、
 ◇アクティブ シートのすべてのセルを表す Range オブジェクトが返されます。

 とあります。

 ですから、一行目の列数+1 の数字を入れれば
 A2セルを返してくれると思います。
        MsgBox Cells(Columns.Count + 1).Address(0, 0)

 ＞Cells(5)
 は、A1からワークシートの右端下端のセルの中で
 　　左から右・上から下　ですから
 右へ５つ行ったセル　E1 セル

 ＞Range("A1").Cells(5)
 は、A列の中で　1行目から
 　（右へ行けないので）
 下へ５つ行ったセル　A5 セル

 ＞Range("D2").Cells(1, 5)
 D列から5列右のH列の中で 2行目から
 　（右へ行けないので）
 下へ１つ行ったセル　H2 セル

 ＞Range("D2").Cells(5)
 は、D列の中で　2行目から
 　（右へ行けないので）
 下へ５つ行ったセル　D6 セル

 Cellzahyoで試された結果とも一致する様です。

 以上のことから
 　範囲には、左から右、上から下にインデックス番号が振られ
 　Cellsの()の中では、その番号が使用される。
 それから、
　 Cells(行,列)と書いた場合は
 　イメージとしては、「列」の方で先に縛りを入れておいて
 　一列だけになるから「行」の方の数と行方向への数が
 　連動するようになっているのではないか。
 と思います。

 これらはあくまでも、私がヘルプを読んでそう思っている事です。
 合っているかもしれませんが、違っているかもしれません。

 ご自身でも、ヘルプを紐解いて行って頂きたいと思います。

 (HANA)

 詳しい解説ありがとうございます
 わかりました

 はい　早速　Helpを見て　勉強します
 VB 6.0 で　Help
 Worksheet.Cells プロパティあるいはCells プロパティ
 で検索しました
 ～プロパティが　１００個でたのですが　Cells プロパティ　が見つからずに
 探しています

 とりあえず　お礼まで

 あらら、タイミング的に　最初の方の
 「今回の場合は同じ様な使用方法になっていますね。」
 を編集したのですが、見ていただけましたか・・・？

 ＞Cells プロパティ　が見つからずに探しています
 でしたら、コード内の　Cells　をマウスでなぞって反転させ
 [ F1 ]を押してください。
 該当するヘルプが表示されると思います。

 ちなみに、エクセルのコードはVBAで
 それを作成するのはVBEです。

 まさか無いとは思いますが
 ＞VB 6.0 で　Help
 なんて書かれていると
 「ちゃんとVBEのヘルプを見てくれているかな？」
 なんて思ってしまいますので。。。

 (HANA)

 ありがとうございます
 いいわけですが　ずーと　これを見ていなく　返事がおくれました。
 他の事で外れていたのと、直系のみを連続（Cascade)の入力と表示をしたく
 Sub　関数化　とか　再帰化とか　悩んでいます。

 それで　小生が使っているのは　MicroSoftOffice 2003 のExcelで　そのマクロ編集で使うのは　HelpをみるとVisualBasic6.0です。これがEditor　VBEでしょうか　それでプロジェクト欄をみると　VBA Project
とありました。

 それで　Cellsを範囲指定して　（CDのInstall指示があり)　F1機能を選ぶと説明がでました。
なるほど　便利です。内容もほぼわかった（つもりです）。

 ＞最初の方の
 「今回の場合は同じ様な使用方法になっていますね。」
 を編集したのですが、見ていただけましたか・・・？

 すみません　小生がこの意味を正確に理解しているか　不安になりました。
 まず　Offsetは　一般の下駄を履かせた＝原点座標をずらした　の意味に使いました。そのような関数がVBであるかどうか
（それこそHelpで見たのですが　なかった）知らないまま　つかいました。
 ”今回は”とあるのは　たまたま同じ使い方になったので、本来は違う使い方ということでしょうか？

 Offset プロパティ
 VBEのHelp（と言うのか　検索語では見つからなかったが）　Offestをコードに書き　F1でみると
表記がでました。
 ずれた位置のCellの値を返す関数と理解しました。（はんにゃ）

 ＞ずーと　これを見ていなく　返事がおくれました。
 お気になさらずに。

 ＞これがEditor　VBEでしょうか
 マクロを作るときには、エクセルの
 メニュー・ツール(T)→マクロ(M)
 　Visual Basic Editor(V)
 から開きますよね？
 って事で、開いたウィンドウは一般的に
 VBEと呼ばれていると思います。

 ＞”今回は”とあるのは　たまたま同じ使い方になったので、
 ＞本来は違う使い方ということでしょうか？
 本来がどうかは分かりませんが、違う結果を返す事も有ると思いますよ。
 それぞれ「1」の数えはじめが違うので( , )の中がずれていますが
 どちらも、A1→B2に移動するとして　例えば、こんな感じで。

 '------
Sub test1()
    Cells.Clear
    Range("A1:B3").Offset(1, 1).Value = "○"
    Range("A1:B3").Cells(2, 2).Interior.ColorIndex = 37
End Sub
 '------

 こっちの方が分かりやすいかな？
 '------
Sub test2()
    Cells.Clear
    Range("A1:E3").Offset(4).Value = "○"
    Range("A1:E3").Cells(5).Value = "●"
End Sub
 '------

 (HANA)

 久しぶりにこの教室に来たのですが　いろんな授業がいっぱいで　この授業はすーと前になりました
 さて　小生にとって　懸案であった
 子らの内　婚姻した一人が　次代の親となって　その次代を継ぐ、直系のみは　親子関係をその都度データに書かなくても　
 自動で書き繋ぎ（Cascade　あるいは再帰）をしてくれるソフトを作ってみました。

 http://www.mediafire.com/download.php?zhj2mgnzm2v
 に載せましたので　落として　解凍して　ごらんください。
 該当するデータは以下の４代の例です

 長女		1779.2			娘
 始		1760.1			父
 始の妻		1764.1			母
 長男		1780.1			息子
 次男		1781.1			息子
 四男		1787.3			息子
 三男　		1785.1			子親 　　
 [他家」嫁		1788.1			母
 長女２		1798.1			娘
 長男２		1800.1			息子親
 [他家２」嫁		1810.1			母
 長女3		1815.1			娘
 長男3		1817.1			息子親
 [他家3」嫁		1810.1			母

 この入力のルールは　直系の子はこの兄弟姉妹行の最後に記し、子親、娘親と記す。
 その次行に婚姻相手を記す。

 まだ　系譜図の結果は完全な梯段になっておらず。子の記載と婚姻の記載が重なっており
 以後　これを自動でまとめたい

　Hana さん始め　先達の方に　これまでの多くの助言指導に感謝しつつ

 系譜図の梯段の自動化も含め　よりスマートな　コードを助言頂ければ幸いです

　Test1　てｓｔ２のOffset　Cellの記載は早速勉強します。

 Hana さんの　ご教授のCells,Offsetの記述理解できたようです。
 ありがとうございます

 その後　直系のデータの書込みと　その梯段系譜線の自動表記ができるようになりました。
 http://www.mediafire.com/download.php?dzwtnmeyrnd
 に載せました。ご覧になって　ご意見　助言をいただければ　幸いです。

 コードを直接　ここに記載することが　良ければ　投稿します。

 なんだかだんだんそれっぽく成ってきていますね。
 私には既に、何がどの様に処理をされているのか分かりませんが
 この調子で頑張って下さい。

 (HANA)

 なんだかおおがかりですね～
 はんにゃさんには仕様書を作成することをお勧めします。(とおりすがり)

 Hanaさんの書かれたコードを可能な部分で　必ずしも繰り返して使わないものも
 頭の整理のためにSubルーチン（というのでしょうか）化して
 やっと　それをいろいろ組み合わせて　結果的にでる様になりました。

 Hanaさんにも　当初から仕様を定めるように助言を頂いていました。

 やっている内に　こんなことが出来そう、出来たら良いなと　追加　修正してきましたが
 一先ず　これで実用してみます。
 元々　この利用価値がなければ　改良の必要性も起きないでしょう。

 たまに　既存の家系譜作成のソフトを見るのですが、本当に輻輳（錯綜）する関係線を
 図面の面積を増やさないで　あるいは交差する線を　うまく配置、配線するのか　疑わしいです。
 小生のも　現在は　直系系譜線がすこし効率的になりましたが　印刷するには　ずいぶん空きページがあります。
 また　婚姻の線もCellsでなく、描線でつなげることも必要です。

 電子回路のプリント基板の自動配線のソフトなどはどうしているのかな　と日ごろ不思議に思っています

 もし　どなたかに　原理的な　方法論的なことを教えて頂ければ幸いです。

 （はんにゃ）

 "HANAさん" <> "Hanaさん"

コメント返信：

[ 一覧(最新更新順) ]

[[20090627150504]] 『西暦～和暦の変換 あるいは系譜図の作成 改題』（はんにゃ） ページの最後に飛ぶ

[[20090627150504]]　『西暦～和暦の変換　あるいは系譜図の作成　改題』（はんにゃ）　ページの最後に飛ぶ