[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『入力データによってデータを上書きするには?』(たんたかたん)
いつもたくさんの人にお世話になっております。
色々勉強中、
下記コードも教えてもらっている最中ではございますが、
検証テスト期間もあり、並行で投稿させてもらいました。
(20171226095551にて受講中)
<コード>
Sub ながれの整理()
Dim 貼付SH As Worksheet
Dim WB As Workbook
Dim 貼付行 As Long, 貼付元最終行 As Long
Dim フラグ As Boolean
'#1部分、不要なら削除
If MsgBox("開いているすべてのCSVファイルからデータを取得します", vbYesNo) = vbNo Then Exit Sub
Set 貼付SH = ThisWorkbook.Worksheets("Work")
For Each WB In Workbooks
If LCase(WB.Name) Like "*.csv" Then 'ThenWBの名前が「*.csv」だったら フラグ = True 'With 貼付SH 'Dim targetRow As Long ←使っていない変数は削除 'Dim maxRow As Long ←同上 'targetRow = Cells(Rows.Count, 2).End(xlUp).Row ←使用していないため削除 '「WORK」シートのA列最終行+1 '貼付行 = Cells(Rows.Count, 2).End(xlUp).Row + 1 '「WORK」シートのA列最終行+1 'End With '貼付行の取得しか貼付SHは利用されないためWithステートメントを使用しなくていいかも 貼付行 = 貼付SH.Cells(Rows.Count, 2).End(xlUp).Row + 1
With WB.Worksheets(1) 'csvならシートは1つしかない 'targetRow = Cells(Rows.Count, 1).End(xlUp).Row '貼付元最終行 = targetRow + 1 貼付元最終行 = .Cells(Rows.Count, 1).End(xlUp).Row + 1 '↑上2行をひとまとめに、Cellsの前に「.」をつける(もこな2さんのご説明参照) '管理番号 .Range(.Cells(2, "A"), .Cells(貼付元最終行, "A")).Copy 貼付SH.Range("B" & 貼付行) '確認番号 .Range(.Cells(2, "Y"), .Cells(貼付元最終行, "Y")).Copy 貼付SH.Range("E" & 貼付行) '開始時間 .Range(.Cells(2, "Z"), .Cells(貼付元最終行, "Z")).Copy 貼付SH.Range("F" & 貼付行) '終了時間 .Range(.Cells(2, "AA"), .Cells(貼付元最終行, "AA")).Copy 貼付SH.Range("G" & 貼付行) End With 'WB.Close '#2部分、不要なら削除 End If Next WB
'開いてるブックのなかにcsvが一個もなかったらメッセージを表示
If フラグ = False Then MsgBox ("開いてるブックのなかにcsvは発見できませんでした")
'==後始末(省略可能)
Set 貼付SH = Nothing
Set WB = Nothing
End Sub
このコードをいただいていますが、検証テストで
入力データが重複した場合、新規行で追加されてしまいます。
管理番号はユニークのため、
管理番号が同じものがあれば上書き
〃 なければ最終行に追加
という感じは可能でしょうか?
管理番号は未来永劫変わらなくても、開始終了時間は変更される可能性が
あるとのこと。
よって抽出時もあえて同じ情報も読み込むことをするらしいです。
机上ですが思っているのは
管理番号をif文かで比較し、管理番号が合致・同じであればその行に貼付け
非合致であれば最終行に挿入
でも、管理番号の他に対象行もおさえとく必要があり・・・
難しく考えすぎでしょうか。
まだコードまではできません。。
< 使用 Excel:Excel2010、使用 OS:Windows7 >
(隠居じーさん) 2018/01/26(金) 14:20
上書きと追加を同時進行でも良いですが、うまくまとまらないならば、2回の処理に分けてしまうのも良いと思います。1回目は、同じ番号があれば情報を上書きし、違う番号は読み捨て。2回目は、逆に同じ番号は読み捨てて、違う番号は追記。こうすれば、1回目の処理中は行が増えないので、考えやすいでしょう。
(???) 2018/01/26(金) 14:26
こういうのは流れを一度日本語で書いてみるとよいと思います
多少省略しますが現状は下記のようになっています
実行確認メッセージ
全てのファイルに対しての繰り返し
CSVファイルなら以下の処理 貼付け先の最終行取得 貼付け元の最終行取得 管理番号をコピー 貼付け 確認番号をコピー 貼付け 開始時間をコピー 貼付け 終了時間をコピー 貼付け CSVファイル向けの処理ここまで 繰り返しここまで
たんたかたんさんが考えている処理を加えるなら
下記のようになると思います
実行確認メッセージ
全てのファイルに対しての繰り返し
CSVファイルなら以下の処理 ★貼付け先に開いているCSVの管理番号があるかチェック ★もしすでに管理番号が存在したら 貼付け行 = 見つかった管理番号の行 存在しなければ 貼付け行 = 貼付け先シートのの最終行+1 ★管理番号有無での分岐ここまで 貼付け元の最終行取得 管理番号をコピー 貼付け行に貼付け 確認番号をコピー 貼付け行に貼付け 開始時間をコピー 貼付け行に貼付け 終了時間をコピー 貼付け行に貼付け CSVファイル向けの処理ここまで 繰り返しここまで
上記を参考にコードのタタキを書いてみるとよいでしょう
(隙間時間) 2018/01/26(金) 15:00
(1)
>管理番号はユニークのため、
>管理番号が同じものがあれば上書き
> 〃 なければ最終行に追加
>という感じは可能でしょうか?
可能だと思います。
(2)
>管理番号は未来永劫変わらなくても、開始終了時間は変更される可能性が
>あるとのこと。
>よって抽出時もあえて同じ情報も読み込むことをするらしいです。
ちょっと意味がわかりません。
「管理番号」という項目と、「開始終了時間」という項目があるのでしょうか?
(3)
>机上ですが思っているのは
>管理番号をif文かで比較し、管理番号が合致・同じであればその行に貼付け
>非合致であれば最終行に挿入
>でも、管理番号の他に対象行もおさえとく必要があり・・・
お悩みのポイントがよくわかりません。
特に「管理番号の他に対象行もおさえとく」ということがよくわからないです。
とりあえず、(1)の回答として、1例を示します。
配列を使った処理など、もっと効率のいいコードはありますけど、CSV、取込先のブック(シート)が両方開いているなら、2重ループで1行ずつ比較するという手も考えられますよね。「管理番号」がA列にあるとして以下のような感じになるかとおもいます。
(↓「BookB.xlsx」→「BookA.xlsx」にコピーする例)
Sub Sample2()
'==変数の宣言とか
Dim dstSH As Worksheet Set dstSH = Workbooks("BookA.xlsx").Worksheets(1) Dim srcRow As Long, dstRow As Long
'==主処理
With Workbooks("BookB.xlsx").Worksheets(1) For srcRow = 2 To .Cells(Rows.Count, "A").End(xlUp).Row For dstRow = 1 To dstSH.Cells(dstSH.Rows.Count, "A").End(xlUp).Row '転送先と元データを比較してA列の値が一致すればForを抜ける If dstSH.Cells(dstRow, "A").Value = _ .Cells(srcRow, "A").Value Then Exit For Next dstRow '「Exit For」を通らなければ、「dstRow」が最終行+1されることを利用する .Range(.Cells(srcRow, "A"), .Cells(srcRow, .Columns.Count).End(xlToLeft)).Copy _ dstSH.Cells(dstRow, "A") Next srcRow End With End Sub
もし、興味があったらステップ実行して研究してみてください。
(もこな2) 2018/01/29(月) 00:48
説明足らずで申し訳ございません。
csvファイルの中身で全て書き換えであれば、WORKシートの情報を書き込む前に消すだけで良いかと。 workシートに古い情報を貯めこむのであれば 新規というか、コードの書き換えが必要ですが、可能だと思います。 WORKシートは過去のデータをそのまま引継ぎます。
(シート名が悪かったかもしれませんが)
よって、一旦全クリアして〜というのは
仕掛け上できません。
(たんたかたん) 2018/01/29(月) 11:12
>よって、一旦全クリアして〜というのは
>仕掛け上できません。
了解です。でしたら
???さん
隙間時間さん
が粗方フローをご呈示されていますのでその通りに
更新されれば、
また、もこな2さんも更新のヒントとなるサンプルをUPされています。
基本はもこな2さん..等たくさんの回答者さん、
と たんたかたん さん のご努力で出来ていますので
そう、難しくないとおもいます。
挑戦していただいて。調べても解らない箇所を具体的に
ご質問くだされば、多くの回答者さんから
適切なアドバイスがあろうかと。
(隠居じーさん) 2018/01/29(月) 11:44
もう少し、ご自身で進めるべきかと思うので、考え方のヒントなぞ。 課題、ありがとうございます。
作業の合間になんとかとやっていますが、まだまだ思案中です。
上書きと追加を同時進行でも良いですが、うまくまとまらないならば、2回の処理に分けてしまうのも良いと思います。1回目は、同じ番号があれば情報を上書きし、違う番号は読み捨て。2回目は、逆に同じ番号は読み捨てて、違う番号は追記。こうすれば、1回目の処理中は行が増えないので、考えやすいでしょう。 if文の繰り返しっぽいですね。
これも少し検討してみます。
もう少しWEBで検索しないとですが、ありがとうございます。
隠居じーさんさん
ありがとうございます。もこな2さんや隙間時間さんのアドバイスを
検証してみます。皆様にはいつも大変助かっております。
自分の知識が浅いのがバレテ怖いですが。。。
(たんたかたん) 2018/01/29(月) 19:40
前回コードは、複数の行をいっぺんに取り込みたいからCOPYメソッドを使ってるんだと思うんですが、今回のように1行ずつ読む場合は、Valueプロパティを直接参照するほうが、クリップボード経由するより若干はやいかもしれません。
Sub Sample2修正()
'==変数の宣言とか
Dim dstSH As Worksheet Set dstSH = Workbooks("BookA.xlsx").Worksheets(1) Dim srcRow As Long, dstRow As Long '==主処理 With Workbooks("BookB.xlsx").Worksheets(1) For srcRow = 2 To .Cells(Rows.Count, "A").End(xlUp).Row For dstRow = 1 To dstSH.Cells(dstSH.Rows.Count, "A").End(xlUp).Row '転送先と元データを比較してA列の値が一致すればForを抜ける If dstSH.Cells(dstRow, "A").Value = _ .Cells(srcRow, "A").Value Then Exit For Next dstRow
'「Exit For」を通らなければ、「dstRow」が最終行+1されることを利用する dstSH.Cells(dstRow,"B").Value = .Cells(srcRow,"A").Value '管理番号 ・ '確認番号 ・ '開始時間 ・ '終了時間 Next srcRow End With End Sub
追加で気になることとして、追加で読み込むCSVが複数あってどちらにも同じ管理番号あったら、どうするんでしょう?
元のコードを考えると、Workbookコレクションみてるってことは、ブック(CSV含む)を開いた順にCSVか判定して処理ことになるわけで、新しいCSV,古いCSVって順で開いてマクロ実行したら、管理番号が重複した場合せっかく新しいCSVのデータを取り込んでも、古いCSV由来のデータで上書きされるとおもいますけど大丈夫ですか?(なんか変な表現になったけど、要は管理番号がかぶったときは開始時間が新しいほうを残すとかじゃなくて、単純に上書きでいいんですか?ってことです)
(もこな2) 2018/01/29(月) 22:36
Option Explicit '********************************************************** Sub ながれの整理xx() Dim 貼付SH As Worksheet, WB As Workbook Dim 貼付行 As Long, 貼付元読込行 As Long, 貼付元最終行 As Long Dim フラグ As Boolean, 検査行 As Long, 検査最終行 As Long If MsgBox("開いているすべてのCSVファイルからデータを取得します", vbYesNo) = vbNo Then Exit Sub End If Set 貼付SH = ThisWorkbook.Worksheets("Work") For Each WB In Workbooks If LCase(WB.Name) Like "*.csv" Then フラグ = True With WB.Worksheets(1) 'csvならシートは1つしかない 'CSVの最終行取得 貼付元最終行 = .Cells(.Rows.Count, 1).End(xlUp).Row 'シート、Workの最終行取得 検査最終行 = 貼付SH.Cells(貼付SH.Rows.Count, 2).End(xlUp).Row 'CSVの最初の行...A2 〜 最後の行までループ For 貼付元読込行 = 2 To 貼付元最終行 '同じ管理番号が無かった時の値を予め設定。 貼付行 = 貼付SH.Cells(貼付SH.Rows.Count, 2).End(xlUp).Row + 1 '同じ管理番号の有無調査の為、シートWork B2 〜 最終行までループ For 検査行 = 2 To 検査最終行 '管理番号が同じなら貼り付け行をシートWorkで見つかった行に設定 If .Cells(貼付元読込行, "A").Value = 貼付SH.Cells(検査行, "B").Value Then 貼付行 = 検査行 End If Next 検査行 '各情報を上記で設定した貼付け行へコピー '管理番号 .Cells(貼付元読込行, "A").Copy 貼付SH.Cells(貼付行, "B") '確認番号 .Cells(貼付元読込行, "Y").Copy 貼付SH.Cells(貼付行, "E") '開始時間 .Cells(貼付元読込行, "Z").Copy 貼付SH.Cells(貼付行, "F") '終了時間 .Cells(貼付元読込行, "AA").Copy 貼付SH.Cells(貼付行, "G") Next 貼付元読込行 End With End If 'WB.Save 'WB.Close '#2部分、不要なら削除 Next WB '開いてるブックのなかにcsvが一個もなかったらメッセージを表示 If フラグ = False Then MsgBox ("開いてるブックのなかにcsvは発見できませんでした") End If '==後始末(省略可能) Set 貼付SH = Nothing Set WB = Nothing End Sub (隠居じーさん) 2018/01/29(月) 23:17
>元のコードを考えると、Workbookコレクションみてるってことは、ブック(CSV含む)を開いた順にCSVか判定して処理ことになるわけで、新しいCSV,古いCSVって順で開いてマクロ実行したら、管理番号が重複した場合せっかく新しいCSVのデータを取り込んでも、古いCSV由来のデータで上書きされるとおもいますけど大丈夫ですか?(なんか変な表現になったけど、要は管理番号がかぶったときは開始時間が新しいほうを残すとかじゃなくて、単純に上書きでいいんですか?ってことです)
→確かにcsvファイルの読み込ます順番でとも心配になりましたが、
csvファイルを抽出する段階で最新版がダウンロードされるので、大丈夫かと思います。
要は研究データを期間範囲指定でダウンロードしますが、
管理番号は(一応絶対)変更ありませんが、その他(確認番号、開始、終了時間)は
修正される場合があります。
よって、
・管理番号が同じであれば全て上書き
・管理番号が同じでなければ追加
という考え方で大丈夫と思っています。
(たんたかたん) 2018/01/30(火) 09:55
夜遅くに申し訳ございません。
一旦、解析する前にそのままコードを使わせてもらったのですが、
読み込んだデータが重複で貼り付けられます。
私なりに構文を1行ずつ実行し、データの動き推移を見ております。
〜かなり不慣れで時間かかっておりますが。。。
また自分なりの解釈がまとまったら投稿いたします。
取り急ぎ
(たんたかたん) 2018/01/30(火) 12:16
以下は先日提示したフローです(若干順序を変えました)
実行確認メッセージ
全てのファイルに対しての繰り返し
CSVファイルなら以下の処理 貼付け元の最終行取得 ★貼付け先に開いているCSVの管理番号があるかチェック ★もしすでに管理番号が存在したら 貼付け行 = 見つかった管理番号の行 存在しなければ 貼付け行 = 貼付け先シートの最終行+1 ★管理番号有無での分岐ここまで 管理番号をコピー 貼付け行に貼付け 確認番号をコピー 貼付け行に貼付け 開始時間をコピー 貼付け行に貼付け 終了時間をコピー 貼付け行に貼付け CSVファイル向けの処理ここまで 繰り返しここまで
この★部分について、WorksheetFunction.Matchというものがあります
どういうものかご自身で調べられたら、使い方については下記サイト熟読されるとよいかと思われます
http://www.relief.jp/docs/excel-vba-error-trap-worksheetfunction-match.html
For文の必要ない、上記フローそのままのコードが作成できるはずです
(隙間時間) 2018/01/30(火) 13:42
もともと取り込み先のブックと いくつかのCSVファイルが開いてて…っていう話からスタートしてるので、たとえば、取り込み先、1/30に抽出したCSV 1/20に抽出したCSVって順番で開いて、それぞれにおなじ管理番号があった場合、その管理番号の情報は、最新の情報が1/30にあったとしても、1/20の情報に上書きされますよってことです。
マクロ上で、抽出したのはいつかっていう比較をするようになっていないので、最新のものが抽出されようがされまいが関係なく、手動で開いた順番がすべてです。
もちろん、上記のことはCSVを複数開かないようにするとか、古いものから順番に開くように徹底させるなど、運用でも対応できます。
ただ、個人的には、CSVを開いておいてからマクロでコピーって処理よりは、特定のフォルダに保存されてるCSVを順番に読み込んで というような処理をすることのほうが一般的とおもうので、以前述べたとおり、読み込むところからマクロ化しなくて大丈夫なのかなって思います。
(もこな2) 2018/01/31(水) 21:33
隙間時間さん
おしえていただいたパスの内容を現在、熟読中ですが・・・。
On Error Resume Nextでとりあえずループを繰り返し
WorksheetFunction.Matchでそのシート内対象文言を検索。
で、結果○○でした。
というくらいの認識レベルです。
他のサイトも併せて検索してみます。
同時に「with」についても検索している段階でございます。
正直、理解にはもう少し時間がかかりそうです。
もこな2さん
>もともと取り込み先のブックと いくつかのCSVファイルが開いてて…っていう話からスタートしてるので、たとえば、取り込み先、1/30に抽出したCSV 1/20に抽出したCSVって順番で開いて、それぞれにおなじ管理番号があった場合、その管理番号の情報は、最新の情報が1/30にあったとしても、1/20の情報に上書きされますよってことです。
いつも上手くお伝えできていない中で、ご対応申し訳ございません。
CSVファイルについてですが・・・
例えば本日(2/2)に抽出条件で2/2〜2/10の間で対象となる管理番号の研究予定データで抽出としたと
します。
その場合、2/3と2/5、2/10で対象の管理番号がヒットし、
管理番号△確認番号△開始時間△終了時間
が抽出されます。
翌日(2/3)に同条件(日付のみ2/3〜2/10)の管理番号で抽出した場合
2/4で対象の研究予定データが増えたり
2/5で確認番号が変わったり、時間が変更になるケースがあります。
当日読み込ますCSVファイルの順番は順不同で大丈夫です。
また抽出する時点が最新情報となります。
よって同じ管理番号があれば上書きし、同じ管理番号がなければ追加ということで
新しい行に追記するというのが動きの説明となります。
私なりに噛み砕いたつもりでの説明ですが、これでもう少し伝わりますでしょうか?
(たんたかたん) 2018/02/02(金) 10:55
>WorksheetFunction.Matchでそのシート内対象文言を検索。
ワークシート関数の「MATCH関数」について調べてみてください・・
>CSVファイルについてですが・・・
たとえば、管理番号/確認番号/開始時間/終了時間 という項目があって管理番号のみで振り分けをすると・・・
(集積用データ)
001/A001/01:00/02:00
(CSV1)
001/A002/12:00/13:00
(CSV2)
001/A003/18:00/19:00
これを、
(CSV1)→(CSV2)と処理した場合
001/A003/18:00/19:00
(CSV2)→(CSV1)と処理した場合
001/A002/12:00/13:00
ってなりますけどいいんですか?って聞いてます。管理番号が違う場合は追加っていうのはわかってますので(そう作ってますので)説明いらないです。
(もこな2) 2018/02/02(金) 11:38
いや、こちらの説明・理解不足のためだと思われますので
こちらこそ申し訳ございません。
まだコードにかかる時間ができていないため、
もう一度、読み返して対応しようと思います。
(たんたかたん) 2018/02/02(金) 18:33
紹介したサイトのコードはループの繰り返しなどはしていません
On Error Resume NextはWorksheetFunction.Matchのみに適用しています
Match関数を調べれば出てくると思いますが、
Match関数は一致するものがない場合エラーとなってプログラムが止まってしまうため、
それを回避するため一時的にエラーを無視するよう入れています
(下記にコメントとして追加しておきました)
ネタ帳さんの下記マクロ、ステップインで実際に動かしてみましたか?
Sub Matchのエラー回避_Resume_Next()
Const KEY = "abc"
Dim n As Long: n = 0
On Error Resume Next '一時的にエラー無視
n = WorksheetFunction.Match(KEY, Range("A1:A100"), 0)
On Error GoTo 0 'エラー無視解除
If n = 0 Then
MsgBox "『" & KEY & "』は見つかりませんでした。"
Else
MsgBox n
End If
End Sub
そもそも上記コード理解できますか
コード一行毎に何をしているかコメントを入れてみるとどうなるでしょうか
私が提示したフローに当てはまりませんか?
Withについては前スレッドにも記載しましたが下記サイトが非常に分かりやすく解説しています
http://officetanaka.net/excel/vba/beginner/16.htm
調べても調べてもどうしても理解できないのなら、
こちらで〇〇が理解できませんと手を挙げると親切な方が噛み砕いて説明してくださると思います
(隙間時間) 2018/02/03(土) 11:59
現状、できておりません。
コード自体もエラーの繰り返しで正直分かりません。
入力の時に管理番号を比較し
同じであれば同じ行を上書き
異なれば一番下行に追記と
言葉では言えてもそれを表すのがハイレベルであったことを痛感しました。
とりあえず、期限的なもの、今のタスク量からの調査時間有無もありまして
方向を変え
1.複数csvを読み込み、一番下行へ挿入
※これはご提示いただいたコードです。
2.管理番号でSORTをかける
3.管理番号上下を比較し、同じであれば上側を削除(もしくは非表示)
基本、同じ管理番号でも新たに追加した行が最新と仮定の上ですが。
でどうかと思案中ですが、おかしいでしょうか?
ただ、「with」「On Error Resume Next」などの
使い方、定義は今後のためにも引き続き勉強していきます。
(たんたかたん) 2018/02/09(金) 11:59
これが満たせる条件を整えてあるなら、管理番号がかぶったら上書しても問題ないってことでしょ・・・
(もこな2) 2018/02/09(金) 17:52
マクロで、ということでしたら、
最初のシンプルなやり方を投げて敢えてソートして比較して云々と、
より複雑な手法を取るメリットが分かりません
2と3に関してだったらコードが記述できるということならば別ですが…
前スレッドで口を挟んだため、最後までお付き合いさせていただこうと考えていましたが
これまでのやりとりから見るに恐らくズバリなコードが提示されない限り
回答者がどんなにアドバイスをしても「分からないのでやり方を変えます」の繰り返しとなりそうなので
すみませんが私はここで降りさせていただきます
PS:
新しいやり方を練る前に一度Match関数が何ぞやかお調べいただくことを強くお勧めいたします
(隙間時間) 2018/02/10(土) 01:50
隙間時間さんが、Match関数について調べてみることを勧めておられますし、私も何個か前のコメントで言っているはずですので、Match関数がワークシート関数であることや、どんな働きをするかは、すでにわかっておられることと思います。
また、ワークシート関数をVBAのコード上で使うには、「Application.WorksheetFunction」って付ければいいんだな〜ということも何となくわかっておられることとおもいます。
ここでちょっと注意点というかアドバイスを一つ。
ワークシート上で実際にMatch関数を使ってみれば容易にわかることですが、Match関数が成功すれば(=目的のものが見つかれば)見つかったセルの位置を教えてくれますが、見つからない場合セルにエラー値が表示されることになるはずです。
VBAで実行する場合は実はコレが問題で、何も対策をしないと見つからない場合エラーとなって、マクロの実行が停止しまいます。(=実行時エラー)
そこで、隙間時間さんが紹介されているサイトやその補足では、「On Error Resume Nex」(実行時エラーが出たら、次の行から処理を再開しなさい。)という命令と、「If n = 0 Then」(もし、変数「n」が初期値の0のままだったら)という命令を組み合わせて、検索対象が見つかったのか見つからなかったのかを表示させています。
で、ここからがアドバイスですが、実は、この「Match関数」Application.WorksheetFunction.Match という記述のほかに、Application.Matchという記述も可能です。このような記述をすると、エラー時に実行時エラーになるのではなく、エラー値を返すようになります。
そうすれば、「On Error ○○」でエラートラップをするのではなく、Application.Match自体(または、結果が格納された変数)がエラーかどうかを判定するという方式に変えることもできます。
マクロ上(VBAのコードで)ワークシート関数を使うときは、こんなことも覚えておくと良いかもしれません。
(もこな2) 2018/02/14(水) 03:04
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.