プリズムの煌めきを探して

@shohei_tpcのブログです

USUM捕獲済み伝説ポケモン管理

こんばんは
突然ですが、周回Romが複数あると「あれ?このRomであいつ捕まえたっけ??」となることはありませんか?(ぼくはあります)

捕まえたら1回1回チェックをつけていけばいいのですが、どうせなら見栄えよくチェックつけたいですよね。
という思いではなく、会社が暇すぎたので暇つぶしのため勤務中に作りました


Sheet1「登録」(名前は何でもいいです)
f:id:xyz_1031:20180803221612p:plain
↑はイメージ図

セルA2・・・TN
  B2・・・ID
  C2・・・ROM名

各セルに必要なデータを入力します。

Sheet2「List」(名前は何でもいいです)
イメージ図
f:id:xyz_1031:20180803232958p:plain

ポケモン一覧をコメント欄に記述するので「」の中だけをコピーしてエクセルに貼り付けてください。

1がウルトラサン、2がウルトラムーンにのみ出てくるポケモンです。

ここまで作ったら名前を付けて保存しましょう。
※名前は自由ですが、拡張子は.xlsm(マクロ有効ブック)で。

次にVBAのコードを書いていきます。
※マクロを使うために開発タブを表示する必要があります。

~~~~~~~~マクロ準備~~~~~~~~~~~~~
f:id:xyz_1031:20180803223143p:plain
やり方
[開発] タブを表示する - Office サポート

Visual Basicを開きます。
f:id:xyz_1031:20180803223520p:plain
「ツール」→「オプション」から「変数の宣言を強制する」にチェックをつけておいてください。
f:id:xyz_1031:20180803223709p:plain
~~~~~~~~~~~~~~~~~~~~~~~~~~

Sheet1をダブルクリックで開いて



Sub Registration()

Dim TN, ID, Rom, SheetName As String
Dim WS, List As Worksheet
Dim i, cnt, counter As Long
Application.ScreenUpdating = False

TN = Sheet1.Cells(2, 1).Value
ID = Sheet1.Cells(2, 2).Value
Rom = Sheet1.Cells(2, 3).Value

If TN = "" Then
MsgBox ("TNが未入力です")
ElseIf ID = "" Then
MsgBox ("IDが未入力です")
ElseIf Rom = "" Then
MsgBox ("Romを選択してください")
Else
SheetName = TN & " ( " & ID & " ) "

Worksheets.Add after:=Worksheets(Worksheets.Count)
Set WS = ActiveSheet
WS.Name = SheetName

Set List = Worksheets(2)
counter = List.Cells(Rows.Count, 1).End(xlUp).Row
WS.Cells(1, 1).Value = Rom

For i = 1 To counter
If (Rom = "ウルトラサン" And List.Cells(i, 2).Value = 1) Or (Rom = "ウルトラムーン" And List.Cells(i, 2).Value = 2) Or List.Cells(i, 2).Value = 0 Then
cnt = cnt + 1
List.Cells(i, 1).Copy WS.Cells(2 + cnt, 1)
ElseIf List.Cells(i, 1).Value = "" Then
cnt = cnt + 1
End If
Next i

With WS.Range(WS.Cells(3, 2), WS.Cells(2 + cnt, 2)).Validation
.Delete
.Add Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Formula1:=",〇"

End With

WS.Range("A1").Columns.AutoFit

End If

Application.ScreenUpdating = True

End Sub


上のSub~End Subまでをコピペして終わりです。



使い方
Sheet1に入力した後にマクロを実行するだけです。
※マクロの実行の仕方
①開発タブのマクロ押す→実行
f:id:xyz_1031:20180803225018p:plain


②Sheet1上のどこでもいいので図形を用意→右クリックでマクロの登録後に図形をクリック
これで完成

最初の準備が少し手間ですが、一度マクロを登録すれば新しいシートにポケモンのリストが出てきます。
色を付けたい場合はSheet2であらかじめ色を付けておけば、新しいシートにも反映されます。
エクセルの性質上シート名を同じにすることができないので、シート名はTN+IDにしました。TNムーンが複数あっても大丈夫です。

f:id:xyz_1031:20180803234128p:plain
こんな感じ。