[[20190404043103]] 『range指定数について』(tk) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『range指定数について』(tk)

ご教授お願いします。
セル指定数の制限だと思うのですが、Case2でエラーは発生してしまいます。
Case2の場合の指定方法をお分かりの方お願いします。
区切って2分割でつなげればいいのでしょうか?
エラー表示:アプリケーションの定義またはオブジェクト定義のエラーです。
range指定数を減らすとうまく指定でき動作しました。

Sub SetCommonAddress(mode As Long)

  Dim ss As String
    Select Case mode

      Case 1 '利率表
        ss = "C1,F1,B2,D2,B4,C4,D4,B5,C5,D5,B6,C6,D6,B7,C7,D7,B8,C8,D8,B9,C9,D9,"
        ss = ss & "B10,C10,D10,B11,C11,D11,B12,C12,D12,B13,C13,D13,B14,C14,D14,B15,C15,D15,"
        ss = ss & "B16,C16,D16,B17,C17,D17,B18,C18,D18,B19,C19,D19,B20,C20,D20,B21,C21,D21,"
        ss = ss & "B22,C22,D22,B23,C23,D23,B24,C24,D24,B25,C25,D25,B26,C26,D26,B27,C27,D27,"
        ss = ss & "B28,C28,D28,B29,C29,D29,B30,C30,D30,B31,C31,D31,B32,C32,D32,B33,C33,D33"
        CommonADDRESS = "B1:F33"

      Case 2 '単価
        ss = "C1,D1,"
        ss = ss & "C3,D3,E3,F3,"
        ss = ss & "C4,D4,E4,F4,"
        ss = ss & "C5,D5,E5,F5,"
        ss = ss & "C6,D6,E6,F6,"
        ss = ss & "C7,D7,E7,F7,"
        ss = ss & "C8,D8,E8,F8,"
        ss = ss & "C9,D9,E9,F9,"
        ss = ss & "C10,D10,E10,F10,"
        ss = ss & "C11,D11,E11,F11,"
        ss = ss & "C12,D12,E12,F12,"
        ss = ss & "C13,D13,E13,F13,"
        ss = ss & "C14,D14,E14,F14,"
        ss = ss & "C15,D15,E15,F15,"
        ss = ss & "C16,D16,E16,F16,"
        ss = ss & "C17,D17,E17,F17,"
        ss = ss & "C18,D18,E18,F18,"
        ss = ss & "C19,D19,E19,F19,"
        ss = ss & "C20,D20,E20,F20,"
        ss = ss & "C21,D21,E21,F21,"
        ss = ss & "C22,D22,E22,F22,"
        ss = ss & "C23,D23,E23,F23,"
        ss = ss & "C24,D24,E24,F24,"
        ss = ss & "C25,D25,E25,F25,"
        ss = ss & "C26,D26,E26,F26,"
        ss = ss & "C27,D27,E27,F27,"
        ss = ss & "C28,D28,E28,F28,"
        ss = ss & "C29,D29,E29,F29,"
        ss = ss & "C30,D30,E30,F30,"
        ss = ss & "C31,D31,E31,F31,"
        ss = ss & "C32,D32,E32,F32,"
        ss = ss & "C33,D33,E33,F33,"
        ss = ss & "C34,D34,E34,F34,"
        ss = ss & "C35,D35,E35,F35,"
        ss = ss & "C36,D36,E36,F36,"
        ss = ss & "C37,D37,E37,F37,"
        ss = ss & "C38,D38,E38,F38,"
        ss = ss & "C39,D39,E39,F39,"
        ss = ss & "C40,D40,E40,F40,"
        ss = ss & "C41,D41,E41,F41,"
        ss = ss & "C42,D42,E42,F42,"
        ss = ss & "C43,D43,E43,F43,"
        ss = ss & "C44,D44,E44,F44,"
        ss = ss & "C45,D45,E45,F45,"
        ss = ss & "C46,D46,E46,F46,"
        ss = ss & "C47,D47,E47,F47,"
        ss = ss & "C48,D48,E48,F48,"
        ss = ss & "C49,D49,E49,F49,"
        ss = ss & "C50,D50,E50,F50,"
        ss = ss & "C51,D51,E51,F51,"
        ss = ss & "C52,D52,E52,F52,"
        ss = ss & "C53,D53,E53,F53,"
        ss = ss & "C54,D54,E54,F54,"
        ss = ss & "C55,D55,E55,F55,"
        ss = ss & "C56,D56,E56,F56,"
        ss = ss & "C57,D57,E57,F57,"
        ss = ss & "C58,D58,E58,F58,"
        ss = ss & "C59,D59,E59,F59,"
        ss = ss & "C60,D60,E60,F60,"
        ss = ss & "C61,D61,E61,F61,"
        ss = ss & "C62,D62,E62,F62,"
        ss = ss & "C63,D63,E63,F63,"
        ss = ss & "C64,D64,E64,F64,"
        ss = ss & "C65,D65,E65,F65,"
        ss = ss & "C66,D66,E66,F66,"
        ss = ss & "C67,D67,E67,F67,"
        ss = ss & "C68,D68,E68,F68,"
        ss = ss & "C69,D69,E69,F69,"
        ss = ss & "C70,D70,E70,F70,"
        ss = ss & "C71,D71,E71,F71,"
        ss = ss & "C72,D72,E72,F72,"
        ss = ss & "C73,D73,E73,F73,"
        ss = ss & "C74,D74,E74,F74,"
        ss = ss & "C75,D75,E75,F75,"
        ss = ss & "C76,D76,E76,F76,"
        ss = ss & "C77,D77,E77,F77,"
        ss = ss & "C78,D78,E78,F78,"
        ss = ss & "C79,D79,E79,F79,"
        ss = ss & "C80,D80,E80,F80,"
        ss = ss & "C81,D81,E81,F81,"
        ss = ss & "C82,D82,E82,F82,"
        ss = ss & "C83,D83,E83,F83,"
        ss = ss & "C84,D84,E84,F84,"
        ss = ss & "C85,D85,E85,F85,"
        ss = ss & "C86,D86,E86,F86,"
        ss = ss & "C87,D87,E87,F87,"
        ss = ss & "C88,D88,E88,F88,"
        ss = ss & "C89,D89,E89,F89,"
        ss = ss & "C90,D90,E90,F90,"
        ss = ss & "C91,D91,E91,F91,"
        ss = ss & "C92,D92,E92,F92,"
        ss = ss & "C93,D93,E93,F93,"
        ss = ss & "C94,D94,E94,F94,"
        ss = ss & "C95,D95,E95,F95,"
        ss = ss & "C96,D96,E96,F96,"
        ss = ss & "C97,D97,E97,F97,"
        ss = ss & "C98,D98,E98,F98,"
        ss = ss & "C99,D99,E99,F99,"
        ss = ss & "C100,D100,E100,F100,"
        ss = ss & "C101,D101,E101,F101,"
        ss = ss & "C102,D102,E102,F102"
       CommonADDRESS = "B1:F102"

    End Select

    TargetADDRESS() = Split(ss, ",")
    TargetCellsCOUNT = UBound(TargetADDRESS)
    LASTMODE = mode

End Sub

< 使用 Excel:Office365、使用 OS:Windows10 >


因みに、中段 C60の行程度でまとめると問題なく動作します。
よって指定できる数に限度があるのでは?と思ったのですが
Webで以前見たような?記憶があるのですが
説明うまく書けませんが、よろしくお願いします。
(tk) 2019/04/04(木) 05:28

私の手元ではエラーは発生しません。(Win7,Excel2010)
エラー発生行はどこでしょうか。
 
また、まとめて指定せず、1セルずつ指定する理由は何でしょうか。
セル数のカウントならCountA,CountBlank関数などで調査できますが。
どのようにそれらを使うのかも説明されるとよいでしょう。

(γ) 2019/04/04(木) 07:04


エラーの原因となっている行が開示されてないようにみえる。

もしCommonADDRESS をRange(CommonADDRESS)としているのであれば、255文字制限に引っかかるので質問のようなエラーが出る。

エラーが出るのはどこの行か再確認して情報の開示を求む。

そしてγさんの言うように、恐らくまとめて処理出来るはずなので一度見直したほうが良いように思う。
(ななし) 2019/04/04(木) 09:44


本題への回答ではないですが・・・。
この関数って何をしたい関数なんでしょ。
modeは参照渡しにすれば良さそうだし、
TargetADDRESS()、TargetCellsCOUNT がグローバル変数なのですか?
Redimの話題でも無さそう?
戻り値がいまいちわかりません。

(通りすがり) 2019/04/04(木) 11:20


(γ)さん
(ななし)さん
(通りすがり)さん
返答ありがとうございます。
説明不足ですみません。が
エラーとなるのは★の部分なのですが
最初に掲示したマクロで60行目 → ss = ss & "C60,D60,E60,F60,"で
マクロを終了とし実行すると問題なく動作できましたので、てっきり
指定したセルの限度を超えているものだと思ってました。で
分割して読み込む方法があるのでは、と思い質問させていただきました。
よろしくお願いします。

Sub TestCom_集計_To_率履歴() '◆ numColプロシージャ化

    Dim y As Long
    Dim i As Long
    Dim vv, v
    Dim RowOffset As Long
    Dim ColOffset As Long
    Const mode = 2

    If LASTMODE <> mode Then SetCommonAddress mode

    ReDim v(0, TargetCellsCOUNT)
    With Worksheets("単価")
        For i = 0 To TargetCellsCOUNT
            v(0, i) = .Range(TargetADDRESS(i)).Value
        Next
    End With

    With Worksheets("率履歴")
        .Rows(3).Insert xlShiftDown
        .Cells(3, 1).Resize(, TargetCellsCOUNT + 1).Value = v ’★
    End With
End Sub
(tk) 2019/04/04(木) 13:21

TargetADDRESS()はどこで定義しているのでしょうか。
TargetCellsCOUNTはどこで定義しているのでしょうか。
LASTMODE はどこで定義しているのでしょうか。
If LASTMODE <> mode Then SetCommonAddress mode この式が不成立になる事はあるのでしょうか。

本当に
TestCom_集計_To_率履歴() と SetCommonAddress(mode As Long) だけで動かして★の所でエラーが出ます?
私の環境ではコンパイルも通りませんが。
(通りすがり) 2019/04/04(木) 14:14


If LASTMODE <> mode Then SetCommonAddress modeの判断は初回が
LASTMODE=0でmode=2なのでSetCommonAddressは実行される。
SetCommonAddress内でmode=2なのでcase2が実行される。
変数SSとCommonADDRESSに文字列が定義される
TargetADDRESSが定義されていないのでsplitの行でエラー。
なんとか裏技で通過したとする。
TargetCellsCOUNTは裏技でTargetADDRESSに配列格納されているので値が入る
LASTMODE=2とする
SetCommonAddressを抜けるとき、これらを全部忘れる
TargetCellsCOUNTがゼロなので(定義されていないので)
v(0, 0) = Worksheets("単価").Range(0)).Value となりエラー。
なんとかSetCommonAddressを抜けるときに値を忘れない裏技を使ったとして進めると
.Cells(3, 1).Resize(, TargetCellsCOUNT + 1).Value = v ’★
の行まで行く。ここでエラーが出るならTargetCellsCOUNT の値が大きすぎ。
Resizeできない数値が入っているのでは無いだろうか。

(通りすがり) 2019/04/04(木) 14:33


(通りすがり)さん
>ここでエラーが出るならTargetCellsCOUNT の値が大きすぎ。
以前Web上で見つけたマクロなんですが何かとデータを残すのに便利なので
利用しています。回答者の方に断片的なデータを出してしまい
申し訳ありません。

遅くなりましたが、改めて使い方の説明申し上げます。
帳票に、必要データを入力し入力したデータを別シート(ここでは率履歴)に書出し
必要になったときに履歴データから帳票に読み込むというマクロです。
一連のマクロを以下に列記します。
長いので一部省略します。
データの数を減らすしかないでしょうか?

標準モジュールに
Option Explicit

Public LASTMODE As Long
Public TargetADDRESS() As String, CommonADDRESS As String
Public TargetCellsCOUNT As Long

Sub SetCommonAddress(mode As Long)

  Dim ss As String
    Select Case mode

      Case 1 
        ss = "C1,F1,B2,D2,B4,C4,D4,B5,C5,D5,B6,C6,D6,B7,C7,D7,B8,C8,D8,B9,C9,D9,"
        ss = ss & "B10,C10,D10,B11,C11,D11,B12,C12,D12,B13,C13,D13,B14,C14,D14,B15,C15,D15,"
        ss = ss & "B16,C16,D16,B17,C17,D17,B18,C18,D18,B19,C19,D19,B20,C20,D20,B21,C21,D21,"
        ss = ss & "B22,C22,D22,B23,C23,D23,B24,C24,D24,B25,C25,D25,B26,C26,D26,B27,C27,D27,"
        ss = ss & "B28,C28,D28,B29,C29,D29,B30,C30,D30,B31,C31,D31,B32,C32,D32,B33,C33,D33"
        CommonADDRESS = "B1:F33"

      Case 2 
        ss = "C1,D1,"
        ss = ss & "C3,D3,E3,F3,"
        ss = ss & "C4,D4,E4,F4,"
        ss = ss & "C5,D5,E5,F5,"
        ss = ss & "C6,D6,E6,F6,"
        ss = ss & "C7,D7,E7,F7,"
一部省略(長文)
        ss = ss & "C100,D100,E100,F100,"
        ss = ss & "C101,D101,E101,F101,"
        ss = ss & "C102,D102,E102,F102"
        CommonADDRESS = "B1:F102"

    End Select

    TargetADDRESS() = Split(ss, ",")
    TargetCellsCOUNT = UBound(TargetADDRESS)
    LASTMODE = mode

End Sub

'Address文字列を 行番号、列番号に変換
Sub numRowCol(sAdrs, n As Long, m As Long)

    Dim j As Long
    sAdrs = UCase$(sAdrs)
    For j = 2 To Len(sAdrs)
        If Mid$(sAdrs, j, 1) Like "#" Then
            n = Val(Mid$(sAdrs, j))
            m = Asc(Left$(sAdrs, 1)) - &H40
            If j = 3 Then
                m = m * 26 + Asc(Mid$(sAdrs, 2, 1)) - &H40
            End If
            Exit For
        End If
    Next

End Sub

Sub TestCom_価格利率表_To_価格履歴() '◆numColプロシージャ化

    Dim y As Long
    Dim i As Long
    Dim vv, v
    Dim RowOffset As Long
    Dim ColOffset As Long
    Const mode = 1

    If LASTMODE <> mode Then SetCommonAddress mode

    ReDim v(0, TargetCellsCOUNT)
    With Worksheets("価格利率表")
        For i = 0 To TargetCellsCOUNT
            v(0, i) = .Range(TargetADDRESS(i)).Value
        Next
    End With

    With Worksheets("価格履歴")
        .Rows(3).Insert xlShiftDown
        .Cells(3, 1).Resize(, TargetCellsCOUNT + 1).Value = v
    End With
End Sub

''◆Sheet1から Sheet2 へ
Sub TestCom_単価_To_率履歴() '◆numColプロシージャ化

    Dim y As Long
    Dim i As Long
    Dim vv, v
    Dim RowOffset As Long
    Dim ColOffset As Long
    Const mode = 2

    If LASTMODE <> mode Then SetCommonAddress mode

    ReDim v(0, TargetCellsCOUNT)
    With Worksheets("単価")
        For i = 0 To TargetCellsCOUNT
            v(0, i) = .Range(TargetADDRESS(i)).Value
        Next
    End With

    With Worksheets("率履歴")
        .Rows(3).Insert xlShiftDown
        .Cells(3, 1).Resize(, TargetCellsCOUNT + 1).Value = v
    End With
End Sub

Sub 書き換えセル単価確認()

    Dim s, ss$
    Dim i&, y&
    Const mode = 2

    Select Case mode
      Case 1 
        ss = "C1,F1,B2,D2,B4,C4,D4,B5,C5,D5,B6,C6,D6,B7,C7,D7,B8,C8,D8,B9,C9,D9,"
        ss = ss & "B10,C10,D10,B11,C11,D11,B12,C12,D12,B13,C13,D13,B14,C14,D14,B15,C15,D15,"
        ss = ss & "B16,C16,D16,B17,C17,D17,B18,C18,D18,B19,C19,D19,B20,C20,D20,B21,C21,D21,"
        ss = ss & "B22,C22,D22,B23,C23,D23,B24,C24,D24,B25,C25,D25,B26,C26,D26,B27,C27,D27,"
        ss = ss & "B28,C28,D28,B29,C29,D29,B30,C30,D30,B31,C31,D31,B32,C32,D32,B33,C33,D33"

      Case 2 '
        ss = "C1,D1,"
        ss = ss & "C3,D3,E3,F3,"
        ss = ss & "C4,D4,E4,F4,"
        ss = ss & "C5,D5,E5,F5,"
        ss = ss & "C6,D6,E6,F6,"
        ss = ss & "C7,D7,E7,F7,"
        ss = ss & "C8,D8,E8,F8,"
        ss = ss & "C9,D9,E9,F9,"
        ss = ss & "C10,D10,E10,F10,"
一部省略
        ss = ss & "C97,D97,E97,F97,"
        ss = ss & "C98,D98,E98,F98,"
        ss = ss & "C99,D99,E99,F99,"
        ss = ss & "C100,D100,E100,F100,"
        ss = ss & "C101,D101,E101,F101,"
        ss = ss & "C102,D102,E102,F102"

     End Select

    With Worksheets.Add
        For Each s In Split(ss, ",")
            'Debug.Print s
            For i = 2 To Len(s)
                If Mid$(s, i, 1) Like "#" Then
                    y = y + 1
                    .Cells(y, 1) = Right$("  " & Left$(s, i - 1), 2)
                    .Cells(y, 2) = Mid$(s, i)
                    Exit For
                End If
            Next
        Next
        With .Range("A1", .Range("A1048576").End(xlUp))
            .Sort Key1:=.Columns(1), Header:=xlNo
            .Offset(, 1).Sort Key1:=.Columns(2), Header:=xlNo
            y = .Rows.Count
            ss = .Item(1, 1) & .Item(1, 2) & ":" _
                & .Item(y, 1) & .Item(y, 2)
        End With
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
        Const CLSID_DataObject = "1C3B4210-F441-11CE-B9EA-00AA006B1A69"
        With GetObject("new:" & CLSID_DataObject)
            .SetText ss
            .PutInClipboard
        End With
        MsgBox "Common範囲は " & vbCr & ss, , "範囲はクリップボードにコピーされました "
    End With
End Sub

履歴シートモジュール
Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim y As Long
    Dim i As Long, n As Long, m As Long
    Dim vv, v
    Dim RowOffset As Long
    Dim ColOffset As Long
    Const mode = 2

    If LASTMODE <> mode Then SetCommonAddress mode

    y = Target.Row        ''ダブルクリックのあった行
    If y < 3 Then Exit Sub

    Cancel = True
    v = Me.Cells(y, 1).Resize(, TargetCellsCOUNT + 1).Value

    With Worksheets("単価")
'        .Unprotect
        With .Range(CommonADDRESS)
            vv = .Value
            numRowCol .Item(1, 1).Address(0, 0), RowOffset, ColOffset
            RowOffset = RowOffset - 1
            ColOffset = ColOffset - 1
            For i = 0 To TargetCellsCOUNT
                numRowCol TargetADDRESS(i), n, m
                vv(n - RowOffset, m - ColOffset) = v(1, i + 1)
            Next
            .Value = vv

        End With
        .Activate
        .Range("B8").Select
    End With
End Sub

(tk) 2019/04/04(木) 15:18


はずしているかもしれないですが、
↓で二次元配列をセル範囲に出力させているようにおもいます。
 .Cells(3, 1).Resize(, TargetCellsCOUNT + 1).Value = v

しかし、

 ReDim v(0, TargetCellsCOUNT)

のように、第一要素が、0で始まっているので(1から始まる)セル範囲に適用できない
と怒られているのではないでしょうか?
上記を

 ReDim v(1 to 1, 1 to TargetCellsCOUNT+1)

として、さらに

 For i = 1 To TargetCellsCOUNT+1
     v(1, i) = .Range(TargetADDRESS(i-1)).Value
 Next

と直したらどうなりますか?

(もこな2) 2019/04/04(木) 18:53


(もこな2)さん
ありがとうございます。
以下、修正してみたのですが結果は同様★部分で止まります。
アプリケーションの定義またはオブジェクト定義のエラーです
    Dim y As Long
    Dim i As Long
    Dim vv, v
    Dim RowOffset As Long
    Dim ColOffset As Long
    Const mode = 2

    If LASTMODE <> mode Then SetCommonAddress mode

    ReDim v(1 To 1, 1 To TargetCellsCOUNT + 1)

    With Worksheets("単価")
    For i = 1 To TargetCellsCOUNT + 1
            v(1, i) = .Range(TargetADDRESS(i - 1)).Value
    Next
    End With

    With Worksheets("率履歴")
        .Rows(3).Insert xlShiftDown
        .Cells(3, 1).Resize(, TargetCellsCOUNT + 1).Value = v’★
    End With
(tk) 2019/04/04(木) 19:08

うーん ちがいましたか、そうなると私にはわからないですね。
ちなみに興味本位でお聞きしたいのですが、
 Sub 書き換えセル単価確認() 
    Const mode = 2
    Select Case mode

↑は何で、Select Caseしているのですか?
Case 1 は使われませんよね?

また、↓は何の処理をされているのでしょか?
sにはいっているのは、セル番地たる文字列ですよね?

 For Each s In Split(ss, ",")
   For i = 2 To Len(s)
     If Mid$(s, i, 1) Like "#" Then
       y = y + 1
       .Cells(y, 1) = Right$("  " & Left$(s, i - 1), 2)
       .Cells(y, 2) = Mid$(s, i)
       Exit For
     End If
   Next
 Next

(もこな2) 2019/04/04(木) 19:49


(もこな2)さん
ありがとうございました。
Excel自体の挙動が変でした。再起動して試してみました。
なんと、通りました。感謝です。
>↑は何で、Select Caseしているのですか?
>Case 1 は使われませんよね?
Case 1も別シートにあり「履歴」を書き込んでいます。
>sにはいっているのは、セル番地たる文字列ですよね?
はいそうです。
とりあえず動作しているので、しばらく様子を見たいと思います。
また、不具合があるようなら書き込ませていただきます。
ありがとうございました。

(tk) 2019/04/04(木) 20:03


解決したのであれば幸いです。
全体の構造がピンと来てませんが、少なくともssに文字列を代入する部分は、皆さんが仰るようにもうちょっと簡単にできそうに思います。
   Sub test()
      Dim ss As String
      Dim MyRNG As Range

      ss = "C1,D1,"
      For Each MyRNG In Range("C3:F102")
         ss = ss & MyRNG.Address(0, 0) & ","
      Next MyRNG

      ss = Left(ss, Len(ss) - 1)

      Debug.Print ss

   End Sub

こういうことですよね?

(もこな2) 2019/04/04(木) 20:13


書き忘れ

select case の方は、

   Sub test2()
      Const mode As Long = 2 'モードを2で固定!

      Select Case mode
         Case 1:      MsgBox "モード1だよ"
         Case 2:      MsgBox "モード2だよ"
         Case Else:   MsgBox "モードが1でも2でもないよ"
      End Select

   End Sub

のようにmodeを定数として扱っているので、2以外があり得ないため、1は使われないと思います。

(もこな2) 2019/04/04(木) 20:26


さらに書き忘れ。
 If Mid$(s, i, 1) Like "#" Then

は、

 If Mid$(s, i, 1) Like "*#*" Then

としたかったのでは?
ただ、1文字しか取り出さないから、

  If Mid$(s, i, 1) = "#" Then

と同じになるように思うのと、どちらにせよセル番地たる文字列に"#"なんてはいってないから、Trueになることが無いため、いらないとおもうのですが…

(もこな2) 2019/04/04(木) 20:43


 >エラーとなるのは★の部分なのですが 
 > Sub TestCom_集計_To_率履歴() '◆ numColプロシージャ化 
 >     .Cells(3, 1).Resize(, TargetCellsCOUNT + 1).Value = v ’★

 実行してみましたが、エラーなんて出なかったですよ?

 大体、「TestCom_集計_To_率履歴() 」を単独で実行したってしょうがないですよね?

 じゃ、どっかからCallされているのかと思いましたが、コールしているプログラムなんて見当たらないですけど。

(半平太) 2019/04/04(木) 21:44


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.