VBAでこんなことできます_その２ 読み込んだcsvファイルのデータをフィルタかけて別ファイルに出力マクロ
どんなマクロ
csvファイルを選択して、読み込んで、任意の列に任意のキーワードでフィルタかけて、別ファイルに出力します。
読み込むcsvとしては
テストデータ・ジェネレータさん
で生成された住所データなどが適当かと思いますが、
基本的に1行目に項目名が入っている普通の表形式のcsvなら
大体対応できる・・・はずなのではないか感がなきにしもあらず
という気がします。
操作シート
検索列を指定して検索語を入れたときに該当件数を出すために、
数式が色々入ってます。
その辺りの内容は前回記事を参照ください。
vba-belle-equipe.hatenablog.com
使い方
１）ファイル選択ボタン-> csvファイルを選択する
２）ファイル読込ボタンを押す
３）「検索列」を選択
４）「検索語」を入力
５）シート作成ボタンを押す
６）xlsx出力かcsv出力のボタンを押す
※ちらっと写る住所や名前などは、実在しないデータです。
コード抜粋（フィルタかけて新しいシートに出すところ）
Dim csvWS As Worksheet Dim newWS As Worksheet Set ws = ThisWorkbook.Sheets("操作") Set csvWS = ThisWorkbook.Sheets("csv") 'シートを新しく作り、検索語をその名前にする sheetName = ws.Range("D8") Set newWS = Worksheets.Add(After:=Sheets(2)) newWS.Name = sheetName Dim i As Long, j As Long Dim maxRow As Long Dim crRow As Long '新しいシートのカレント行 Dim buf As String Dim targetCol As Long targetCol = ws.Range(対象列アドレス) With csvWS '列名が入った1行目をコピーする .Rows(1).Copy newWS.Rows(1) '最終行の取得 maxRow = .Cells(Rows.Count, 1).End(xlUp).Row crRow = 1 For i = 2 To maxRow '検索語と比較する文字列の作成 buf = .Cells(i, targetCol) If InStr(buf, sheetName) > 0 Then crRow = crRow + 1 .Rows(i).Copy newWS.Rows(crRow) End If Next End With
フィルターかけると言いつつ、該当列に検索語が含まれるかを1行1行判定しているだけというのは内緒。
でも色々と条件が加わったりする場合は、用意されているAutoFilterより柔軟に使えたりします。
諸注意
・Windowsで動作します
・デモ用なので、エラー処理とかちゃんとやってません
・自由に使っていただいて構いませんが、自己責任でお願いします
・ちょっとまて！ そんなそうびじゃ あぶないぞ
Excelで入力規則ドロップダウンリストに他シートの列名を指定する とか
はじめに
「VBAでこんなことできますシリーズ」の続きで
なんか、csv開いて、特定の言葉でデータを絞ったものを別シートに出して、
最終的にExcelファイルかcsvで出力できるみたいの
を作ろうと思ったら途中で色々あって、それなりに時間も使ってしまったので、ひとまず記事にしてみます。
VBAで入力規則ドロップダウンのリストを設定する
csvシートに、テストデータ・ジェネレータさんで生成された住所データがあります。（実在しない人たちのデータです）
この1行目の「NO、 名前。。。」という部分を
他のシートのセルの入力規則として設定するためのコードはこちらです。
Sub 検索列入力リスト設定() Dim maxCol As Long Dim rng As Range With ThisWorkbook.Sheets("csv") maxCol = .Cells(1, Columns.Count).End(xlToLeft).Column If maxCol < 1 Then Exit Sub Else Set rng = .Range(.Cells(1, 1), .Cells(1, maxCol)) End If End With With ThisWorkbook.Sheets("テスト").Range("B2").Validation .Delete .Add Type:=xlValidateList, _ Operator:=xlEqual, _ Formula1:="=csv!" & rng.Address End With End Sub
無事、下のように出てきました。
（「テスト」というシートのB2セルです）
対象列に該当の言葉を含むセルがいくつあるかを動的に表示させてみようかしら（VBAのイベントとか使わずに）
ここが結構難しかったです。
VBAerは何でもVBAで解決したがるから複雑な関数とか実は苦手
というのはわりとあるあるかなと思うんですが、どうでしょう。
まあ、言い訳ですか。。。
- COUNTIFを使えば、部分一致での件数を表示させることができるけど範囲指定を動的にって？？？
- INDIRECTを使えばセル上に表示されている文字列をアドレスとして関数に入れられる（らしい）
- てことはセル上に「csv!列名:列名」て出せればいいんだろうが！
試行錯誤と謎の逆ギレの末、上のように色々組み合わせるとできることがわかりました。
下のようになっているcsvシートのK列（住所）に検索語である「北海道」を
含むセルがいくつあるかを表示しています。
。。。。。。。。。。。。。。。。
ここまでやんなきゃいかんのかな。
もっといいやり方あるのかもしれませんが、まあできたのでよし。
こんなん出ました
検索語を変更しても変わります（当たり前）
VBAでこんなことできます_その１ フォルダ作成
イントロ
どうもinageです。
最近はRPAとかを中心に業務自動化であれこれやっております。
RPAとかGASとかIFTTTとか、手作業でやっていたことを自動化できる仕組みが色々あって、便利な世の中ですね。
たまに理解のある現場だと「VBAで良くないっすか」という意見が通ったり、運が良いと「じゃあちょっと教えてよ」と言われることもあって嬉しい限りです。
そんな時、「VBAでこんなことできます」ととりあえず見せて「おー」と言ってもらいたい。
何も準備がない時にすぐに見せられるものがあればいいな、ということで久しぶりにこのブログを思い出しました。
が
あんまり見せられるものがない。。。
で
簡単なもので、どんなことができるかわかるようなものをほぼ自分のためにいくつか上げていきたいとおもいます。
どんなマクロ
フォルダを選択して、その配下にサブフォルダを一括で作ります。
使い方
１）フォルダ選択ボタン-> フォルダを選択する
２）B７以下に作りたいサブフォルダ名を入力していく
３）フォルダ作成ボタンを押す
コード
Option Explicit Sub フォルダ選択() Dim r As Range Set r = Sheets(1).Range("B2") With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False .InitialFileName = ActiveWorkbook.Path If .Show = True Then r = .SelectedItems(1) End If End With End Sub Sub フォルダ作成() Dim rootPath As String Dim i As Long Dim maxRow As Long Dim folderName As String Dim fullPath As String Const startRow = 7 rootPath = Range("B2") If Dir(rootPath, vbDirectory) = "" Then MsgBox "フォルダを選択してください" End End If maxRow = Cells(Rows.Count, 2).End(xlUp).Row If maxRow < startRow Then MsgBox "サブフォルダ名をB列に1つ以上入れてください" End End If For i = startRow To maxRow folderName = Cells(i, 2) fullPath = rootPath & "¥" & folderName ' Debug.Print i & "_" & fullPath If Dir(fullPath, vbDirectory) = "" Then MkDir fullPath End If Next End Sub
諸注意
・Windowsで動作します
・デモ用なので、エラー処理とかちゃんとやってません
・自由に使っていただいて構いませんが、自己責任でお願いします
・バナナはおやつに入りません
ASUSのMEMOPADが反応しなくなったのでとりあえずFireタブレットでLineができるようになれ
イントロ
愛用のASUS ME173タブレットが2度目の反抗期（電源が入らない。反応しない）に入り、前回は色々調べて
タブレットの電源が入らない！ASUS MeMO Padを強引に蘇生させた方法 | 伊東制作所
こんな感じのことをして回復したのですが、今回は何度やっても反応がない。
で、手元にあるFireタブレットでとりあえずLineだけでも復活させたいなと。
こちらのページをとても参考にさせていただきました。
ただし自分の環境のせいか、何か変わったのか、一部うまくいかなかったのでその記録。
・Windows10 Home
・Fire タブレット 8GB、ブラック(第5世代)
- 出版社/メーカー: Amazon
- 発売日: 2015/09/30
- メディア: エレクトロニクス
- この商品を含むブログ (30件) を見る
Lineゲットまでの手順
Lineはamazonのアプリストアにないので、
- FireをUsbでつないでPCから色々できるようにする（ドライバ入れたりデバッグできるように設定したり）
- FireにGoogle Playストアを入れる
- Google PlayストアからLineとか入れる
という手順を踏む必要があります。
うまくいかなかったところ
androidlover.net
Google USB Driver をインストールしても Android ADB Interface として認識されない。
解決策
どうやってたどり着いたか忘れましたが、上の本家amazonのページにKindle Fire 用のusbドライバーへのリンクがあります。
（ちなみに、日本語ページには無さそう。why?）
ｈｔｔｐｓ://s3.amazonaws.com/android-sdk-manager/redist/kindle_fire_usb_driver.zipというところ
デバイスマネージャーでFireを一旦削除してから解凍した
[Fire_Devices ADB drivers.exe]
を実行して、接続しなおすと
こんな感じで、認識されました。
ADBとして認識されたあとは、参考ページのとおりにやってGoogle Playストアがインストール完了。
androidlover.net
改めまして、お世話になりました。
大事なこと
JSO（自己責任でお願いします）
VBAを使ってロト６のデータを形にする その３
はじめに
前回、
vba-belle-equipe.hatenablog.com
「ボーナス数字」と「連続ハズレ回数」を出すところまでいきました。
今回は連続でハズレた回数の履歴をつけていきたいと思います。
「結果」シート
変わりません。
「メイン」シート
連続ハズレ回数を記録する列が増えています。
※回数はどこまでも伸びる可能性がありますが、とりあえず40回以上は一くくりにしてみました。
コード
こんな感じになりました。
Sub 更新() Dim startnum As Long, endnum As Long Dim i As Long, j As Long Dim hit(1 To 43) As Long Dim bonus(1 To 43) As Long Dim nohit(1 To 43) As Long Dim renzoku(1 To 43, 0 To 40) As Long Dim num As Long, num2 As Long With Sheets("メイン") startnum = .Range("C1") endnum = .Range("C2") .Range("C3") = endnum - startnum + 1 End With With Sheets("結果") For i = startnum + 1 To endnum + 1 '連続ハズレ For j = 1 To 43 nohit(j) = nohit(j) + 1 Next '本数字（当たり処理） For j = 2 To 7 num = .Cells(i, j) hit(num) = hit(num) + 1 '連続ハズレ調整 nohit(num) = nohit(num) - 1 If nohit(num) > 40 Then nohit(num) = 40 End If renzoku(num, nohit(num)) = renzoku(num, nohit(num)) + 1 nohit(num) = 0 'ハズレリセット Next j 'ボーナス数字 num = .Cells(i, 8) bonus(num) = bonus(num) + 1 Next i End With For i = 6 To 48 Cells(i, 3) = hit(i - 5) '当選回数 Cells(i, 4) = bonus(i - 5) 'BONUS Cells(i, 5) = nohit(i - 5) '連続ハズレ '連続ハズレ過去回数 For j = 7 To 46 Cells(i, j) = renzoku(i - 5, j - 7) Next j Next i End Sub
連続ハズレ回数の履歴
連続ハズレ回数（現在進行形）を
Dim nohit(1 To 43) As Long
という配列に入れるのは前回と同じです。
（当たったら、０にリセットされる）
加えて今回は、各数字と連続ハズレ回数の情報を持たせるために
Dim renzoku(1 To 43, 0 To 40) As Long
という２次元配列を使っています。
こういう表のイメージです。
「1 To 43」の部分で各数字ごとに行を作り、「0 To 40」で回数ごとの列を作っているという感じでしょうか。
結果
こんなん出ました～
（ごちゃごちゃしすぎるので、下のほうは割愛しています）
考察
連続40回ハズレというのはどれくらいの確率でしょうか。
１回ハズレる確率は、37/43で、およそ86％です。
それが40回連続ともなると、0.25％くらい。
しかし、40回以上連続のハズレは、ロト６の歴史で20回以上出現しているようです。
そこまで珍しいことではないみたいですね。
では、連続で外れているという情報を次に買う際の根拠としてよいか。
難しいところです。
絶対に雨が降る雨ごい
と同じように、買い続ければいずれはその数字が当たると思いますが、
問題は
一緒に当たる数字が何なのかわからん
ということですよね。
方法をご存じの方がいたら是非ともご連絡ください。
