*** 台風の名前一覧を作る、準備のためのマクロ ***

 きのう(18日)15時に台風3号が発生しました・・・ということで、思い出しました。
 以前の記事で(『*** JUDY AND MARY ***』)こんなことを書いていましたが・・・。

 先ほどリンクをはったリストJUDYMARYがないように、このリストは何回か変更されています。過去のリストを作ってみないことには原因が分かりませんが、デジタル台風のサイトを使えば何とかなりそう・・・。

 ・・・というのはちょっと見通しが甘かったです。
 何とかなるにはなったのですが、これがけっこう難儀なことで・・・。


 おまけに、マクロを作ったのはすでに1ヵ月ほど前のこと。
 そのとき何を考えていたのか、忘れていたりしますが、気を取り直し・・・。

 メインのマクロはこちら。
 Excelのメニューで「データ」→「外部データの取り込み」→「新しいWebクエリ」を選択し、デジタル台風のアドレスを入力・・・という過程を「マクロの記録」で書き出しただけ。。。
 「Name = "1954.html.ja_2"」となっているのは、マクロを記録した時に取り込んだページが1954年のページだったから・・・というだけの話。深い意味はありません。
      → 1954年のページ http://agora.ex.nii.ac.jp/digital-typhoon/year/wnp/1954.html

 この部分のうち、自力で編集したのは繰り返し処理くらい(サブルーチンは後述)。
 マクロの記録はほんとうに便利です。

  ※ 最後の年が1999となっているのは、JTWC(米軍合同台風警報センター)が命名した、
     アルファベット順に並んだリストが使われていたのが1999年までだからです。

---------------------------------------------------------------
Public y_s, y_e As Single

Sub Macro1()

Application.ScreenUpdating = False

y_s = 1951 ’この年から取得
y_e = 1999 ’この年まで取得

Sheets("data1").Select
Cells.Select
Selection.Clear

For i = y_s To y_e

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://agora.ex.nii.ac.jp/digital-typhoon/year/wnp/" & i & ".html.ja", _
Destination:=Range("$A$1"))
.Name = "1954.html.ja_2"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xl
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

Next i

Call aaa
Call bbb

End Sub

---------------------------------------------------------------

 このマクロを実行すると、シート「data1」には次のようにデータが取り込まれます。
     (クリックすると画像が「多少」拡大されます)

画像

 取り込んだデータは1951年から1999年まで49年分ですが、とても入りきらないので(最後はRV列!)、
ここでは2年分だけ(1999年と1998年)表示しています。

 1年分の表示には10列必要で、
  1列目:号数   2列目:台風番号 3列目:名前   4列目:地域 5列目:発生日時
  6列目:消滅日時 7列目:寿命   8列目:最低気圧 9列目と10列目は空白

となっていますが、リストを作るのに必要なのは「台風番号」と「名前」だけ。
 この2要素に絞り、別シートに抜き出すのが次のサブルーチンです。

---------------------------------------------------------------
Sub aaa()

Sheets("data2").Select
Cells.Select
Selection.Clear

yy = y_e - y_s + 1

For i = 1 To yy
Sheets("data1").Select

For j = 8 To 50
If Len(Cells(j, i * 10 - 8)) = 0 Then
a = j - 1
GoTo 10
End If
Next j

10
Sheets("data1").Select
Range(Cells(8, i * 10 - 8), Cells(a, i * 10 - 7)).Select
Selection.Copy

Sheets("data2").Select
Range("A1").Select
Selection.Insert Shift:=xlDown
ActiveSheet.Paste

Next i

End Sub

---------------------------------------------------------------

 「台風番号」と「名前」だけを取り出し、シート「data2」に並べた結果は次の通り。
 49年分なので、ひたすら縦に並べていくと、ここにはとても入りきりません。最後は1320行目!
 ・・・なので、ここでは26個だけ表示しています。



 ひたすら縦に並んだ「台風番号」「名前」はアルファベット順に並べるマクロです。
 先頭がAの名前、先頭がBの名前・・・Case文でこんなに場合分けをしたのは初めてです。。。

---------------------------------------------------------------
Sub bbb()

Sheets("data3").Select
Cells.Select
Selection.Clear

Application.ScreenUpdating = False

a = 1

For i = 1 To 2000

Sheets("data2").Select

t_num = Cells(i, 1)

If t_num = 0 Then
GoTo 200
Else

t_name = Cells(i, 2)

x1 = Left(Cells(i, 2), 1)
x2 = Left(Cells(i, 2), 3)

Sheets("data3").Select

Select Case x1
Case "A":
a = a + 1
If Len(Cells(2, a * 2)) = 0 Then
Cells(2, a * 2) = t_num: Cells(2, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "B":
If t_num = 195905 Or t_num = 196126 Or t_num = 199622 Or t_num = 199811 Then
a = a + 1
End If
If Len(Cells(3, a * 2)) = 0 Then
Cells(3, a * 2) = t_num: Cells(3, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "C"
If Len(Cells(4, a * 2)) = 0 Then
Cells(4, a * 2) = t_num: Cells(4, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "D"
If Len(Cells(5, a * 2)) = 0 Then
Cells(5, a * 2) = t_num: Cells(5, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "E"
If Len(Cells(6, a * 2)) = 0 Then
Cells(6, a * 2) = t_num: Cells(6, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "F"
If Len(Cells(7, a * 2)) = 0 Then
Cells(7, a * 2) = t_num: Cells(7, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "G"
If Len(Cells(8, a * 2)) = 0 Then
Cells(8, a * 2) = t_num: Cells(8, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "H"
If Len(Cells(9, a * 2)) = 0 Then
Cells(9, a * 2) = t_num: Cells(9, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "I"
If Len(Cells(10, a * 2)) = 0 Then
Cells(10, a * 2) = t_num: Cells(10, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "J"
If Len(Cells(11, a * 2)) = 0 Then
Cells(11, a * 2) = t_num: Cells(11, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "K"
If Len(Cells(12, a * 2)) = 0 Then
Cells(12, a * 2) = t_num: Cells(12, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "L"
If Len(Cells(13, a * 2)) = 0 Then
Cells(13, a * 2) = t_num: Cells(13, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "M"
If Len(Cells(14, a * 2)) = 0 Then
Cells(14, a * 2) = t_num: Cells(14, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "N"
If x2 <> "NO-" Then
If Len(Cells(15, a * 2)) = 0 Then
Cells(15, a * 2) = t_num: Cells(15, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
End If
Case "O"
If Len(Cells(16, a * 2)) = 0 Then
Cells(16, a * 2) = t_num: Cells(16, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "P"
If Len(Cells(17, a * 2)) = 0 Then
Cells(17, a * 2) = t_num: Cells(17, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "Q"
If Len(Cells(18, a * 2)) = 0 Then
Cells(18, a * 2) = t_num: Cells(18, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "R"
If Len(Cells(19, a * 2)) = 0 Then
Cells(19, a * 2) = t_num: Cells(19, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "S"
If Len(Cells(20, a * 2)) = 0 Then
Cells(20, a * 2) = t_num: Cells(20, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "T"
If Len(Cells(21, a * 2)) = 0 Then
Cells(21, a * 2) = t_num: Cells(21, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "U"
If Len(Cells(22, a * 2)) = 0 Then
Cells(22, a * 2) = t_num: Cells(22, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "V"
If Len(Cells(23, a * 2)) = 0 Then
Cells(23, a * 2) = t_num: Cells(23, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "W"
If Len(Cells(24, a * 2)) = 0 Then
Cells(24, a * 2) = t_num: Cells(24, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "X"
If Len(Cells(25, a * 2)) = 0 Then
Cells(25, a * 2) = t_num: Cells(25, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "Y"
If Len(Cells(26, a * 2)) = 0 Then
Cells(26, a * 2) = t_num: Cells(26, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
Case "Z"
If Len(Cells(27, a * 2)) = 0 Then
Cells(27, a * 2) = t_num: Cells(27, a * 2 + 1) = t_name
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
End Select

End If
Next i

End Sub

---------------------------------------------------------------

 Case文で場合分けしているのは、台風の名前(アルファベット)の最初の一文字。
 何をやっているのか、「C」を例に補足すると・・・。

-----------------------------------------------------------------
Case "C"  「名前」の最初の一文字がCの場合
If Len(Cells(4, a * 2)) = 0 Then  「台風番号」が入るべき4行目のセルが空白だったら
Cells(4, a * 2) = t_num: Cells(4, a * 2 + 1) = t_name
         4行目の偶数列には「台風番号」、奇数列には「名前」を入れる
ElseIf Len(Cells(28, a * 2)) = 0 Then: Cells(28, a * 2) = t_num: Cells(28, a * 2 + 1) = t_name:
         4行目が空白でない場合、28行目が空白だったら、
         28行目の偶数列には「台風番号」、奇数列には「名前」を入れる

Else: Cells(29, a * 2) = t_num: Cells(29, a * 2 + 1) = t_name: End If
         28行目が空白でない場合、29行目が空白だったら、
         29行目の偶数列には「台風番号」、奇数列には「名前」を入れる

-----------------------------------------------------------------

 なんだか意味不明に思えますが、なぜこのような処理が必要かというと、台風は基本的に北西太平洋エリアのリストにしたがって命名されますが、まれに北東太平洋エリアからの熱帯擾乱が台風になることがあり、このような場合、すでに北東太平洋エリアのリストにしたがって名前がつけられています。
 そうすると、必ずしもアルファベット順にならないわけで、AからZまで一巡する間に同じアルファベットで始まる名前が複数現われることになります。このように複数現われる時の予備としての役割が28行目と29行目です。さすがに重なったとしても3つまででしょうから、これで十分かと・・・。

 以上が典型的な記述ですが、そうでないのが、「A」と「B」と「N」。
 まずは、「N」から・・・。異なるのは初めに条件文がついていること。

    If x2 <> "NO-" Then

 気象庁は台風として解析したけれど、JTWCが台風と解析しなかったので名前がつけられていない・・・、そんな台風が時々あり、デジタル台風では「NO-NAME」として扱っています(・・・気象庁の電文でも「NO-NAME」として扱われていたかもしれませんが、詳細はよく分かりません・・・)。
 復元しようとしているリストに「NO-NAME」は必要ないので、除外するために記述しています。

 次に「A」。追加されているのはごく短い、次の一文。

  a = a + 1

 a は列を表す変数です。AからZまで一巡するまでは同じ列でよいですが、一巡した後のAは当然、列を変えて表示させなければいけません。このための記述です。

 では、「B」の追加されているのは何かというと・・・。

-----------------------------------------------------------------
If t_num = 195905 Or t_num = 196126 Or t_num = 199622 Or t_num = 199811 Then
a = a + 1
End If
-----------------------------------------------------------------

 これは「NO NAME」の逆・・・、すなわち気象庁は台風として解析しなかったけれど、JTWCは台風と解析したので名前がついている・・・ような場合に対応したものです。この場合、「台風のリスト」には当然、含まれないので、結果としてAが飛ばされた形になり、何もしないと列を表す変数 aが増えません。
 条件文の書き方から分かるように、マクロを回してチェックしたところ、数が合わない・・・ということで、Aがない部分を後から補ったものです。エレガントとは程遠く、単なる力わざになってしまいました。。。

 説明が長くなりましたが・・・、このサブルーチンを実行すると、下のようになります。
 「台風番号」と「名前」の2列で1セットで、最後はDW列!
 やはり、とても入りきりませんので、1959年の途中まで・・・。


 全部見たい方は、こちらをどうぞ。それなりの覚悟のうえ、ご覧ください。。。

画像


 これで、一応、準備は整いました。
 「一応」と書いたのは、この表はさまざまな例外を含んでいて、その処理が必要だからです。
 このあたりの事情と完成した(!?)リストは別の記事にて・・・。

"*** 台風の名前一覧を作る、準備のためのマクロ ***" へのコメントを書く

お名前
ホームページアドレス
コメント