「etTomioのトホホ日記」　2011年4月　　　　　　　　

◆2011/4/26
　本日0時よりマイクロソフトからIE9の正規版がリリースされています。私はWin7には64ビット版、Vistaには32ビット版を入れました。残念ながらXPにはインストールできません。使い勝手はまだ検証していませんが、少なくとも製品候補版よりはいいでしょう。なおIE9は3/15にリリース予定でしたが、大震災に考慮して通信インフラの負荷を懸念し、今日まで延期したそうです。
◆2011/4/26
　昨日コードの改竄が終わったという「新幹線検索システム」の顔です。16年も前から、雑誌を持っていながら、そして新幹線という興味のあるプログラムなのに、実に長い日を要しました。プロの書いているコードを20行ぐらい削除した箇所もあります。
   
◆2011/4/25
　今から16年も前のExcel5の参考書から、「新幹線検索システム」を時刻表を見ながら、東海道、山陽、九州と全てデータを手入力し、プロの作ったシステムを改竄していました。
　でも、現在のExcelはフォームはダイアログシートからは作りません。新たに入力フォームは震災前に作っていました。でもプロの作ったコードは書き換えられないでいました。所詮、オレはちっちゃな会社のコードを土日に書く程度か･･･　プロには全く歯が立たない･･･　焼酎飲んだら天才プログラマーなんて言いながら･･･　オレの頭では無理だ･･･
　そして震災。田んぼ作業以外は引きこもりみたいな土日を過ごしていましたので、読書するぐらいで、プログラムからは離れていました。たまにはプロの書いたコードを読んでみましたが、全く･･･
　オレの能力はその程度かと、先日の土日は、コードを1行ずつ調べ始めました。ダミーを作ってテストしてみたり。その都度書き換え、書き換え･･･
　昨日夕方にはかなり書き換えました。そして今日の早朝、会社で用事を済ませ、6時過ぎから7時頃まで･･･　ほぼ書き換えました。
　この経験から思うことは、プロってのは簡潔に無駄なく流れるようにコードを書いている。これが16年も前に書かれたコードか　という驚嘆、この勉強はいつか生かしたいと思います。
　下に主要コードを書いています。
◆2011/4/25
Option Explicit

Const 最大抽出数 = 500
Const 条件範囲先頭行 = 991
Const 抽出範囲先頭行 = 1001

Dim 検索結果 As Worksheet
Dim 上り列車本数, 下り列車本数


Private Sub CommandButton1_Click()
'新幹線検索システム　2011/4/25 ettomio

Dim 駅数
Dim 始発駅番号, 終着駅番号, 時刻表名, 条件行
Dim 該当列車本数, 列車名
Dim 列車総本数
Dim 時刻表 As Worksheet
Dim データ範囲 As Range, 条件範囲 As Range, 抽出範囲 As Range
Dim 並べ替え範囲 As Range, 並べ替えキー As Range
Dim X1, X2, Y, I


' 画面の描画を止める
Application.ScreenUpdating = False

' 列車本数を数える
上り列車本数 = Application.CountA(Range("時刻表上り!$A$2:$A$500"))
下り列車本数 = Application.CountA(Range("時刻表下り!$A$2:$A$500"))
' 駅数を数える
Worksheets("時刻表下り").Activate
駅数 = Range("駅名").Columns.Count
' 「検索結果」ワークシートをクリアする
Set 検索結果 = Worksheets("検索結果")
検索結果.Activate
Y = 検索結果.Range("列車種別").Row
X1 = 検索結果.Range("列車種別").Column
X2 = 検索結果.Range("終着時刻").Column
検索結果.Range(Cells(Y, X1), Cells(Y + 最大抽出数, X2)).Clear
検索結果.Range(Cells(Y, X1), Cells(Y + 最大抽出数, X2)).Interior.ColorIndex = 15
' ダイアログボックスでの入力結果を「検索結果」ワークシートにセット
始発駅番号 = D_始発駅.ListIndex
終着駅番号 = D_終着駅.ListIndex
検索結果.Range("始発駅").Value = D_始発駅.List(始発駅番号)
検索結果.Range("終着駅").Value = D_終着駅.List(終着駅番号)
検索結果.Range("始発駅2").Value = D_始発駅.List(始発駅番号)
検索結果.Range("終着駅2").Value = D_終着駅.List(終着駅番号)
検索結果.Range("始発時刻自").Value = E_始発時刻自.Text
検索結果.Range("始発時刻至").Value = E_始発時刻至.Text
検索結果.Range("終着時刻自").Value = E_終着時刻自.Text
検索結果.Range("終着時刻至").Value = E_終着時刻至.Text
' 運賃／料金を「検索結果」ワークシートにセット
検索結果.Range("運賃").Value = Worksheets("運賃表").Cells(始発駅番号 + 2, 終着駅番号 + 2) '書き換え
検索結果.Range("指定席特急料金").Value = Worksheets("指定席特急料金表").Cells(始発駅番号 + 2, 終着駅番号 + 2) '書き換え
検索結果.Range("自由席特急料金").Value = Worksheets("自由席特急料金表").Cells(始発駅番号 + 2, 終着駅番号 + 2) '書き換え
検索結果.Range("のぞみ特急料金").Value = Worksheets("のぞみ特急料金表").Cells(始発駅番号 + 2, 終着駅番号 + 2) '書き換え
' 上り／下りのどちらかを調べる
If 始発駅番号 < 終着駅番号 Then
' 下り
時刻表名 = "時刻表下り"
列車総本数 = 下り列車本数
Else
' 上り
時刻表名 = "時刻表上り"
列車総本数 = 上り列車本数
始発駅番号 = 駅数 - 始発駅番号 - 1 '書き換え
終着駅番号 = 駅数 - 終着駅番号 - 1 '書き換え
End If
Set 時刻表 = Worksheets(時刻表名)
時刻表.Activate
' 検索条件をセットする
時刻表.Range(Cells(条件範囲先頭行, 1), Cells(条件範囲先頭行 + 6, 5)).Value = ""
時刻表.Range(Cells(抽出範囲先頭行 + 1, 1), Cells(抽出範囲先頭行 + 最大抽出数, 駅数 + 2)).Value = ""
時刻表.Range(Cells(1, 1), Cells(1, 駅数 + 2)).Copy
時刻表.Cells(抽出範囲先頭行, 1).Select
時刻表.Paste
時刻表.Cells(条件範囲先頭行, 1).Value = "列車種別"
時刻表.Cells(条件範囲先頭行, 2).Value = D_始発駅.List(D_始発駅.ListIndex)
時刻表.Cells(条件範囲先頭行, 3).Value = D_始発駅.List(D_始発駅.ListIndex)
時刻表.Cells(条件範囲先頭行, 4).Value = D_終着駅.List(D_終着駅.ListIndex)
時刻表.Cells(条件範囲先頭行, 5).Value = D_終着駅.List(D_終着駅.ListIndex)
条件行 = 条件範囲先頭行 + 1

' XlOnではなくTrue
If C_のぞみ.Value = True Then
検索条件セット 時刻表, 条件行, "のぞみ"
条件行 = 条件行 + 1
End If
If C_ひかり.Value = True Then
検索条件セット 時刻表, 条件行, "ひかり"
条件行 = 条件行 + 1
End If
If C_こだま.Value = True Then
検索条件セット 時刻表, 条件行, "こだま"
条件行 = 条件行 + 1
End If
' 2010/7/18 書き換え
If C_さくら.Value = True Then
検索条件セット 時刻表, 条件行, "さくら"
条件行 = 条件行 + 1
End If
' 2011/2/19 書き換え
If C_みずほ.Value = True Then
検索条件セット 時刻表, 条件行, "みずほ"
条件行 = 条件行 + 1
End If
' 2011/2/19 書き換え
If C_つばめ.Value = True Then
検索条件セット 時刻表, 条件行, "つばめ"
条件行 = 条件行 + 1
End If
条件行 = 条件行 - 1

' 列車を検索する
Set データ範囲 = 時刻表.Range(Cells(1, 1), Cells(列車総本数 + 1, 駅数 + 2))
Set 条件範囲 = 時刻表.Range(Cells(条件範囲先頭行, 1), Cells(条件行, 5))
Set 抽出範囲 = 時刻表.Range(Cells(抽出範囲先頭行, 1), _
Cells(抽出範囲先頭行 + 最大抽出数, 駅数 + 2))
データ範囲.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=条件範囲, _
CopyToRange:=抽出範囲
' 検索された列車の本数を数える
該当列車本数 = Application.CountA(Range(Cells(抽出範囲先頭行 + 1, 1), _
Cells(抽出範囲先頭行 + 列車総本数, 1)))
' 「検索結果」ワークシートに該当列車本数をセットする
検索結果.Range("列車本数").Value = 該当列車本数
If 該当列車本数 = 0 Then
Beep
MsgBox "該当する列車がありません"
検索結果.Activate
Application.ScreenUpdating = True
Exit Sub
End If

' 検索結果を並べ替える
Set 並べ替え範囲 = 時刻表.Range(Cells(抽出範囲先頭行 + 1, 1), _
Cells(抽出範囲先頭行 + 該当列車本数, 駅数 + 2))
If O_表示順序始発.Value = True Then
Set 並べ替えキー = 時刻表.Cells(抽出範囲先頭行 + 1, 始発駅番号 + 3) '書き換え
Else
Set 並べ替えキー = 時刻表.Cells(抽出範囲先頭行 + 1, 終着駅番号 + 3) '書き換え
End If
並べ替え範囲.Sort Key1:=並べ替えキー, order1:=xlAscending, _
Header:=xlNo

' 結果を「検索結果」ワークシートにコピーする
時刻表.Range(Cells(抽出範囲先頭行 + 1, 1), _
Cells(抽出範囲先頭行 + 該当列車本数, 2)).Copy
検索結果.Activate
検索結果.Range("列車種別").Select
検索結果.Paste
時刻表.Activate
時刻表.Range(Cells(抽出範囲先頭行 + 1, 始発駅番号 + 3), _
Cells(抽出範囲先頭行 + 該当列車本数, 始発駅番号 + 3)).Copy '書き換え
検索結果.Activate
検索結果.Range("始発時刻").Select
検索結果.Paste
Selection.Interior.ColorIndex = 15
時刻表.Activate
時刻表.Range(Cells(抽出範囲先頭行 + 1, 終着駅番号 + 3), _
Cells(抽出範囲先頭行 + 該当列車本数, 終着駅番号 + 3)).Copy '書き換え
検索結果.Activate
検索結果.Range("終着時刻").Select
検索結果.Paste
Selection.Interior.ColorIndex = 15
' 検索結果に罫線を引く
Y = 検索結果.Range("列車種別").Row
X1 = 検索結果.Range("列車種別").Column
X2 = 検索結果.Range("終着時刻").Column
Range(Cells(Y, X1), Cells(Y + 該当列車本数 - 1, X2)).Borders(xlBottom).Weight = xlThin
Range(Cells(Y + 該当列車本数 - 1, X1), Cells(Y + 該当列車本数 - 1, X2)).Borders(xlBottom).Weight = xlMedium
X1 = 検索結果.Range("始発時刻").Column
Range(Cells(Y, X1), Cells(Y + 該当列車本数 - 1, X1)).Borders(xlLeft).Weight = xlThin
Range(Cells(Y, X2), Cells(Y + 該当列車本数 - 1, X2)).Borders(xlLeft).Weight = xlThin
' 列車種別毎に色を塗り分ける
X1 = 検索結果.Range("列車種別").Column
For I = 1 To 該当列車本数
列車名 = 検索結果.Cells(Y, X1).Value
If 列車名 = "のぞみ" Then
Range(Cells(Y, X1), Cells(Y, X1 + 1)).Interior.ColorIndex = 6
Range(Cells(Y, X1), Cells(Y, X1 + 1)).Font.ColorIndex = 1

' 2011/2/19 書き換え
ElseIf 列車名 = "みずほ" Then
Range(Cells(Y, X1), Cells(Y, X1 + 1)).Interior.ColorIndex = 6
Range(Cells(Y, X1), Cells(Y, X1 + 1)).Font.ColorIndex = 1

ElseIf 列車名 = "ひかり" Then
Range(Cells(Y, X1), Cells(Y, X1 + 1)).Interior.ColorIndex = 3
Range(Cells(Y, X1), Cells(Y, X1 + 1)).Font.ColorIndex = 2

' 2010/7/18 書き換え
ElseIf 列車名 = "さくら" Then
Range(Cells(Y, X1), Cells(Y, X1 + 1)).Interior.ColorIndex = 3
Range(Cells(Y, X1), Cells(Y, X1 + 1)).Font.ColorIndex = 2

Else
Range(Cells(Y, X1), Cells(Y, X1 + 1)).Interior.ColorIndex = 5
Range(Cells(Y, X1), Cells(Y, X1 + 1)).Font.ColorIndex = 2
End If

Y = Y + 1
Next
検索結果.Cells(1, 1).Select

' 画面の描画を元に戻す
Application.ScreenUpdating = True

OKクリック

End Sub

' 検索条件をセットする
Sub 検索条件セット(時刻表 As Worksheet, 条件行, 列車種別)
時刻表.Cells(条件行, 1) = 列車種別
If E_始発時刻自.Text <> "" Then
時刻表.Cells(条件行, 2).Value = ">=" + E_始発時刻自.Text
時刻表.Cells(条件行, 3).Value = "<=" + E_始発時刻至.Text
Else
時刻表.Cells(条件行, 2).Value = "<>"
時刻表.Cells(条件行, 3).Value = "<>"
End If
If E_終着時刻自.Text <> "" Then
時刻表.Cells(条件行, 4).Value = ">=" + E_終着時刻自.Text
時刻表.Cells(条件行, 5).Value = "<=" + E_終着時刻至.Text
Else
時刻表.Cells(条件行, 4).Value = "<>"
時刻表.Cells(条件行, 5).Value = "<>"
End If

End Sub

' 「検索条件」ダイアログボックスの「OK」ボタンが押されたときの処理
Sub OKクリック()
' 始発駅と終着駅が同じでないかどうかを調べる
If D_始発駅.ListIndex = D_終着駅.ListIndex Then
Beep
MsgBox "始発駅と終着駅が同じです"

検索結果クリア

Exit Sub
End If
' 始発時刻で「から」「まで」のいずれかしか指定されていないときは
' その時刻ちょうどに出る列車のみを検索する
If E_始発時刻自.Text <> "" And E_始発時刻至.Text = "" Then
E_始発時刻至.Text = E_始発時刻自.Text
End If
If E_始発時刻至.Text <> "" And E_始発時刻自.Text = "" Then
E_始発時刻自.Text = E_始発時刻至.Text
End If
' 終着時刻で「から」「まで」のいずれかしか指定されていないときは
' その時刻ちょうどに到着する列車のみを検索する
If E_終着時刻自.Text <> "" And E_終着時刻至.Text = "" Then
E_終着時刻至.Text = E_終着時刻自.Text
End If
If E_終着時刻至.Text <> "" And E_終着時刻自.Text = "" Then
E_終着時刻自.Text = E_終着時刻至.Text
End If

' 列車種別がどれか1つは選ばれているかどうかを調べる
' 2010/7/18
' xlOffではなくFalse
If C_のぞみ.Value = False And C_ひかり.Value = False And C_こだま.Value = False And _
C_さくら.Value = False And C_みずほ.Value = False And C_つばめ.Value = False Then
Beep
MsgBox "列車種別を最低1つは選んでください"

検索結果クリア

Exit Sub
End If
' エラーが起こっていなければダイアログボックスを閉じる
'DialogSheets("検索条件").Hide
Unload Me

End Sub

Sub 検索結果クリア()
Dim X1, X2, Y

' 「検索結果」ワークシートをクリアする
Set 検索結果 = Worksheets("検索結果")
検索結果.Activate
Y = 検索結果.Range("列車種別").Row
X1 = 検索結果.Range("列車種別").Column
X2 = 検索結果.Range("終着時刻").Column
検索結果.Range(Cells(Y, X1), Cells(Y + 最大抽出数, X2)).Clear
検索結果.Range(Cells(Y, X1), Cells(Y + 最大抽出数, X2)).Interior.ColorIndex = 15

End Sub

Private Sub CommandButton2_Click()
Unload MyForm1
End Sub
　
◆2011/4/23
　震災以来、Excelプログラムとは向き合っていません。今朝、昨年7/3に業務用に書いたコードを開いてみました。参考書には自分のファイルに対しての検索の書き方が載っていましたので、あの日は何だか今日は書けそうな気がすると部屋に籠もりました。自分のファイルから他のファイルを開き検索をかけます。

Sub エラーレコード抽出()
'
' エラーレコード抽出 Macro
' マクロ記録日 : 2010/6/14 ユーザー名 : ettomio 2010/7/3
'
  Sheets("エラーレコード抽出").Select
  Application.Run "配布用確定一覧N.XLS!エラーレコード削除"
  Sheets("併合読込").Select
  Columns("A:Q").Select
  Selection.AutoFilter
  Selection.AutoFilter Field:=17, Criteria1:="#N/A"
  Selection.Copy
  Sheets("エラーレコード抽出").Select
  Range("A1").Select
  ActiveSheet.Paste
  Application.CutCopyMode = False
  Range("R5").Select
  Sheets("併合読込").Select
  Selection.AutoFilter
  Range("R5").Select
  Sheets("エラーレコード抽出").Select

  Application.Run "配布用確定一覧N.XLS!値のあるセルに色を付ける"

  MsgBox "V列の黄色部分の品名を選択し、「検索」ボタンを押して下さい。", vbOKOnly

End Sub

Sub エラーレコード削除()
'
' エラーレコード削除 Macro
' マクロ記録日 : 2010/6/13 ユーザー名 : ettomio
'
  Sheets("エラーレコード抽出").Select
  Application.Run "配布用確定一覧N.XLS!セルの色を消す"

  Columns("A:Q").Select
  Selection.ClearContents
  Range("S3").Select
End Sub

Sub セルの色を消す()
' 20107/3 ettomio
' 2を選択すると罫線まで消えてしまう。
' 次にマクロを実行したとき前回の色が残ってしまうのを回避。

  For y = 2 To 30
  Cells(y, 22).Interior.ColorIndex = 0
  Next
End Sub

Sub 値のあるセルに色を付ける()
' 2010/7/3 ettomio
' セルの色は黄色
' Excel VBAプログラミング 280ページ参照。

  For y = 2 To 30
  If Cells(y, 22).Value <> "" Then
  Cells(y, 22).Interior.ColorIndex = 6
End If
Next
End Sub

Sub 検索を行う()
' 2010/7/3 ettomio
'「エラーレコード抽出」シートのV列のあるセルをクリックして
' マクロを実行すると、その前のU列で「確定一覧」のシート名を拾い
' 変数 sh に代入し、そのシートを開いて検索する。
' Excel VBAプログラミング288ページ参照。
' 但し、他のBookを開きシート名を代入してシートを開いての検索だから全くの別物。


Dim key As String
Dim 検索セル As Range
Dim sh As String

key = ActiveCell.Value
sh = ActiveCell.Offset(0, -1).Value


  Application.Run "配布用確定一覧N.XLS!確定一覧を開く"
  Windows("確定一覧.XLS").Activate
  ActiveWindow.ScrollWorkbookTabs Sheets:=10
  Worksheets(sh).Select

  Set 検索セル = Cells.Find(What:=key & "*", _
  LookIn:=xlValues, LookAt:=xlWhole, _
  SearchOrder:=xlColumns, MatchByte:=True)
If Not 検索セル Is Nothing Then
  検索セル.Activate
End If

End Sub
◆2011/4/21
　この動画は初めて見ます。なんと赤の広場じゃないですか。そして当時のプーチン大統領の姿まで見えます。
Paul McCartney - Let It Be [Red Square, Moscow '2003]
Paul McCartney in Red Square : Yesterday
Paul McCartney - Hey Jude (Live)
◆2011/4/20
　田んぼ作業以外、引きこもりのような土日を過ごしていましたが、先日の土日は5週間ぶりに新幹線撮影に出向きました。
   
◆2011/4/19
Paul McCartney & all artists - Let It Be (Nobel Peace Prize)
LET IT BE - Paul McCartney & Billy Joel
Paul McCartney - Elton John - Sting ＠ Hey Jude　Live
◆2011/4/19
Billy Joel "Piano Man"
Billy Joel: Piano Man
billy joel and elton john-the piano man
◆2011/4/13
　IE9、早速不具合を見つけましたが、ま、正規版のリリースではないので、今のところは我慢して使ってみます。
◆2011/4/13
　帰宅して、インターネットブラウザを見ると、どうも勝手が違うな･･　あっ、そういえば昨夜マイクロソフトのIE9 製品候補版にアップグレードしたんだった。
　IE9βの時は、インストールして、使い物にならないと2時間後に元に戻した記憶があります。今回のIE9 製品候補版は使えそうな気がします。あの震災が無ければ、製品版がリリースされていたかもしれません。
　ただ、IE9はXPでは使えないようです。VistaとWin7だけのようですが、IE8で別に問題もないと思います。
◆2011/4/13
　原発についてはもう余り書かないと言いました。とうとうレベル７まで引き上げられたようですが。
　この処、世間、巷では俄評論家が多いですね。あれだけTV,新聞,週刊誌,ネットと大騒ぎすれば、それも直接の震災地のニュースよりも原発問題の方が多い。原子力の仕組みをご存じなくてもあれだけ騒げば受け売りで喋れますね。
　さてもう買わなくなった週刊誌ですが、表紙だけ見ると、20年後が危ないと書かれています。枝野みたいですね。直ちに健康上は問題ない。週刊誌さん、本当に危機的状況だったら、東京の出版社を逃げて下さい。
　20年後の影響たってね。現在一番の死因は癌ですよ。20年後に癌患者が増えたからって、因果関係が立証されますか。
◆2011/4/12
お便り有り難う御座います。お久しぶりです。
私は、もう余り原発問題に関して考えるの止めました。
以前、震災の後は週刊誌も数冊買っては隅々まで読んでいましたが、
週刊誌は元々購読数を増やすために悲観的に書くモノ。
実は私の三男が川崎に住んでいまして、官邸、東電、保安院の奴らがTVに出なくなったら東京を捨てて逃げて来いと思っています。
元に戻って、週刊誌、そんなに危なければ東京の出版社を逃げ出したらと申し上げたくなります。以前も書いていますね。
今日帰宅したら、NHKで菅直人が記者会見していました。
ま、いいこと言ってますね。アンタはそれを何故震災から1週間後に発表出来なかったんだ !
この危機に乗じて延命を画策するアンタがこの国の復興、原発問題の収束を阻害している第一の危険分子。亡国の輩。最早国際社会では、呆れられているというより、あのトップでは日本はどん底まで落ち込んでしまうと憂虞される有様。この国の将来のため早くトップから降りて下さい。
尚、原発についていはもう余り書きたくありませんが、私の処から一番近くの原発は海を隔てて、直ぐ近くにある愛媛県の伊方原発です。ここには日本で2番目のプルサーマル原発があります。3番目が大事故を起こしている福島の3号炉です。
◆2011/4/9
David Bowie　Rock'n roll Suicide - Live in Japan
David Bowie ft. Mike Garson - My Death (Live)
◆2011/4/4
　それでも桜は咲く
   
◆2011/4/2
　それでも桜は咲く
   
◆2011/4/2
早朝、ある新幹線投稿サイトに以下の文を載せました。

小心者の私は夜アルコールが入ると、
日記や此処に憤懣を書き込み
翌朝になると自己憐憫という有様です。
私の行為こそ傲岸不遜、不安を煽る風評の発信元。
申し訳ございません。
自重致します。

先頭に戻る　　　　過去の日記