Excel CSVの読み込みと書き込み

（対象）Excel　VBA

（確認）Excel2003（多分2010でも使える）

今回はCSVの読み込み及び書き込みについてを書いていこうと思います。

データがCSVになっている、データをCSVに出力したいということは

意外に多いです。

それこそ色々やり方がありそうなものですが、

とりあえずここでは標準的なものを挙げてみます。

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

（前提）

　１．DontLookやOKLookなどを使用→詳しくはこちら

（プログラム　読み込み）

　　'==========================================================

　　' 読み込んだCSVをシートに展開

　　'==========================================================

　　Sub ReadCSV()

　　　　Dim FileNo　　 As Integer

　　　　Dim MyStr　　  As String

　　　　Dim StrBox()　 As String

　　　　Dim WH1　　　  As Worksheet

　　　　Dim I As Long, J As Integer, K As Integer

　　　　DontLook

　　　　'■読込先を初期化

　　　　Set WH1 = Worksheets("作業用")

　　　　WH1.Cells.Delete

　　　　'■読み込み→写し

　　　　FileNo = FreeFile　　’(※1←↓)

　　　　Open ThisWorkbook.Path & "\テスト用データ.csv" For Input As #FileNo

　　　　MyStr = "": I = 1

　　　　Do Until EOF(FileNo)　'(※2)

　　　　　　'△一行分読み込み

　　　　　　Line Input #FileNo, MyStr　　'(※3)

　　　　　　'△区切り文字（この場合は「,」）を探す（※4）

　　　　　　StrBox = Split(MyStr, ",")

　　　　　　For J = 0 to Ubound(StrBox)

　　　　　　  WH1.Cells(I, J + 1).Value = StrBox(J)

　　　　　　Next

　　　　　　I = I + 1

　　　　Loop

　　　　'■閉じる

　　　　Close #FileNo

　　　　OKLook

　　End Sub

（解説）

　※1

　　＝指定したCSVを開く

　　★「変数 = FreeFile」

　　　　＝　変数に空いているファイル番号（FreeFile）を格納

　　★「Open　ファイル名　For 処理モード As #ファイル番号」

　　　　＝指定したファイルを指定したファイル番号で、指定した

　　　　　処理モードで開く

　　　　　※処理モード

　　　　　　・・・Input　：　入力モード（読み込み）

　　　　　　・・・Output　：　出力モード（書き込み）

　　　　　　・・・Append　：　追加モード（書き込み）

　　　　　　・・・Random　：　ランダムアクセスモード（読み込み/書き込み）

　　　　　　・・・Binary　：　バイナリモード（読み込み/書き込み）

　※2

　　＝「Do Until EOF(ファイル番号)」

　　　　指定したファイルを読み終わるまで

　※3

　　＝「Line Input #ファイル番号, 変数」

　　　　ファイルの内容を1行読み込み、その内容を変数に格納する

　※4

　　＝区切り文字で値を区切り、配列変数に格納

　　　→データをシート上に展開

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

（プログラム　書き込み）

　　'=========================================================

　　' CSVに出力する

　　'=========================================================

　　Sub OutPutCSV()

　　　　Dim WH1     As Worksheet

　　　　Dim I As Long, J As Long, K As Integer

　　　　'■読込先を初期化

　　　　Set WH1 = Worksheets("作業用")

　　　　'■CSV作成

　　　　WH1.Copy

　　　　ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\aaa", _

　　　　　　　　　　　　　　　FileFormat:=xlCSV

　　　　ActiveWindow.Close False

　　　　MsgBox "CSVファイルが作成されました" & vbCrLf, vbInformation, "終了報告"

　　End Sub

（解説）

　★CSVの作成

　　１．CSVにしたいシートをコピー

　　２．名前をつけて形式を選択して保存

　　　　「ブック.SaveAs FileName:=パス\ファイル名, FileFormat:=xlCSV」

　　　　※FileFormatで指定出来るファイル　：　参照URL（http://www.officepro.jp/excelvba/book_new/index9.html）

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

以上がCSVの読み込みと書き込みについてです。

もっとスマートなやり方やそれぞれの細かい内容については

グーグル先生にお尋ねくださいませ。

では、今回はこの辺りで。

Excel このブログ内で基礎的な感じでよく出るプロシージャ

今回はこのブログ内でExcelのVBAをご紹介する際
必ずと言っていいほどよく出るプロシージャを
まとめておきます。


＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
１．シートのセット
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

'■変数の宣言
Public WH1 As WorkSheet
Public WH2 As WorkSheet
Public WH3 As WorkSheet

'■シートセットのプロシージャ
Sub SheetSet()

  Set WH1 = Worksheets("シート名1")

  Set WH2 = Worksheets("シート名2")

  Set WH3 = Worksheets("シート名3")

End Sub

―――――――――――――――――――――――

これを作っておくと、たとえば

Sub AAA ()

　　SheetSet '←これで呼び出し

　　WH1.Range("A1").Value =　"ｈｈｈ"

End Sub

のように使えます。
上でやっているのは、WH1（＝シート名1）の
A1セルに「ｈｈｈ」を格納する、です。


シートのセットを変数で行っておく利点は、

　１．シート名が変更になった時にそこだけ
　　　直せば済む
　２．シートのプロパティが絶対予測で出てくる

があります。
ブログ主はExcelでプログラミングする際は
絶対に使うプロシージャの１つです。

---

＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
２．描画の停止と開始等々
＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝

'■描画の停止他

Sub DontLook()

  '画面の移動を見せない

  Application.ScreenUpdating = False

  '確認メッセージを出さない

  Application.DisplayAlerts = False

  'マクロの動作が起因するイベント発生を抑制

  Application.EnableEvents = False

End Sub

このマクロを入れておくだけで画像のちらつきがなくなります。

ちなみにこの反対はこちら

'■描画の開始他
Sub OKLook()

  '画面の移動を見せる

  Application.ScreenUpdating = True

  '確認メッセージを出す

  Application.DisplayAlerts = True

  'マクロの動作が起因するイベント発生を抑制しない

  Application.EnableEvents = True

End Sub

ちなみに使い方は

Sub BBB ()

　　DontLook

　　（作業）

　　OKLook

End Sub

という感じです。
値を次々に入れていく、などの作業の時は
あった方が目に痛くない優しいシステムに
なるのではないかと思います。

１番と併せて、ブログ主が絶対に使うプロシージャです。

---

ということで、このブログ内でよく使われる
プロシージャでした。

Excel VBA ブックの開閉時の動作

（対象）Excel　VBA
（確認）Excel2003～


今回はExcel VBAで、ブックを開いた時・もしくは
閉じた時に自動で動くマクロについてです。


－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

１．ブックを開く時
　以下のように「auto_open」という名前のプロシージャを
　作成し、その中に行いたい処理を書くだけです。
　（データの読み込み処理など）
　

　'============================================

　' ブックを開く時

　'============================================

　Sub auto_open()

 　　（ここに処理）

　End Sub

　
２．ブックを閉じる時
　以下のように「auto_close」という名前のプロシージャを
　作成し、その中に行いたい処理を書くだけです。
　（保存処理など）
　

　'============================================

　' ブックを閉じる時

　'============================================　

　Sub auto_close()

 　（ここに処理）　

　End Sub

 

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－


以上、めちゃくちゃ簡単ですがブック開閉時の動作でした。

Excel ツールバー

（対象）Excel　VBA
（確認）Excel2003


今回は自分で作るツールバーについてです。


マクロを作成した時、実行するために一番簡単なのは
VBAの画面でF5かF8を押すことですね。

その次はシートにボタンを作ってマクロを登録すること
でしょうか。


でもこう思うことはありませんか？

「どこのシートにいてもマクロを実行出来るようにしたい」

と。


ツールバーを使用すればそんな悩みは即解決してしまいますね。
作り方としては以下の通りになります。


－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
　　'============================================
　　'ツールバーの設置
　　'============================================
　　Sub ToolBarOn()
　　　Dim myBar　　　   As CommandBar　　　　'ツールバー
　　　Dim MyButton　　 As CommandBarButton　'ツールバーのボタン
　　　Dim CB　　　　　As Variant　　　　　　'ツールバーの確認用
　　　Dim BCaption(1)　As String　　　　　　'表示文字列
　　　Dim BAction(1)　  As String　　　　　　'登録するマクロ
　　　Dim BText(1)　　 As String　　　　　　'ボタンにカーソル当てた時の説明文
　　　Dim BFace(1)　   As Integer　　　　　　'ボタンに使うアイコン
　　　Dim I　　　　　   As Long　　　　　　　'登録数分回すFor-Next用

　　　'■表示文字列の設定
　　　BCaption(0) = " 表示文字１　"
　　　BCaption(1) = " 表示文字２　"
　　　
　　　'■登録アクション（マクロ）設定＝プロシージャ名
　　　BAction(0) = "ACT1"
　　　BAction(1) = "ACT2"

　　　'■説明文の設定
　　　BText(0) = "ボタンにカーソル当てた時の説明が入るよ"
　　　BText(1) = "ボタンにカーソル当てた時の説明が入るよ"

　　　'■フェイスIDの設定（一覧）
　　　BFace(0) = 50
　　　BFace(1) = 300
　　　
　　　'■すでに同名のツールバーが存在する場合は削除
　　　Set myBar = CommandBars.Add
　　　For Each CB In CommandBars
　　　　　If CB.Name = "動作" Then
　　　　　　　CommandBars("動作").Delete
　　　　　　　Exit For
　　　　　End If
　　　Next

　　　'■ツールバーの名前を設定
　　　myBar.Name = "動作"
　　　myBar.Position = msoBarTop
　　　

　　　'■ツールバー作成（I = 登録するボタンの数）
　　　For I = 1 To 2
　　　　　Set MyButton = myBar.Controls.Add
　　　　　With MyButton
　　　　　　　.BeginGroup = True　　’ボタンとボタンの境界線
　　　　　　　.Style = msoButtonIconAndCaptionBelow　'※
　　　　　　　.Caption = BCaption(I - 1)
　　　　　　　.OnAction = BAction(I - 1)
　　　　　　　.TooltipText = BText(I - 1)
　　　　　　　.FaceId = BFace(I - 1)
　　　　　End With
　　　Next 

　　　'■ツールバーの設置
　　　myBar.Visible = True
　　End Sub



　　'============================================
　　'ツールバーの排除
　　'============================================
　　Sub ToolBarOff()
　　　　Dim myBar As CommandBar
　　　　Dim CB　　　　As Variant

　　　　For Each CB In CommandBars
　　　　　　If CB.Name = "動作" Then
　　　　　　　　CommandBars("動作").Delete
　　　　　　　　Exit For
　　　　　　End If
　　　　Next
　　End Sub

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－


これを実行するとツールバーが作成されます。

以前ご紹介した「ブックの開閉時の動作」に組み合わせると、
開いた時にツールバーを設置し、閉じる時に削除するという
動作が可能になります。


ちなみに、プログラム中の「※」部分についてですが、
ここを変更するとツールバーの表示のされ方が変わります。


下図がその結果です。

もしかしたらやり方がおかしくて上手くなってないところも
あるかもしれませんが。







以上、ツールバーを作ってみようでした。

Excel小技集2

（対象）Excel　VBA
（確認）Excel2003


今回はExcel VBAの小技集パート2を並べてみましょう。
内容によっては2007以降は使えないのでご注意ください。


－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

１．対象のブックを他に開いている人がいないか調べる

　　＝　ActiveWorkbook.UserStatus
　　　　・・・UserStatus(n, 1)　：　ユーザー名
　　　　・・・UserStatus(n, 2)　：　ブックを開いた日時
　　　　・・・UserStatus(n, 3)　：　共有（2）か否（1）か
　　　　参照URL
　　　　※というかここの通りなだけなので細かいことはリンク先を見た方がいい


　（使用例）
　　　'===========================================================
　　　' 対象のブックをほかに開いている人がいないかどうかを調べる
　　　'===========================================================
　　　Sub　CheckAnotherUser()
　　　　　Dim　Users　As　Variant
　　　　　Dim　MSG　　As　String
　　　　　Dim　I　　　As　Integer

　　　　　'■変数に対象の結果を格納
　　　　　Users　=　ActiveWorkbook.UserStatus

　　　　　'■変数の最大数が1の場合は自分だけ、それ以上の場合は誰かが開いている
　　　　　'※UBound(配列変数)　＝　配列変数の最大要素数の取得
　　　　　If　UBound(Users)　=　1　Then
　　　　　　　MsgBox　"他に開いているユーザーはいません"
　　　　　Else
　　　　　　　For　I　=　0　To　UBound(Users)　-　1
　　　　　　　　　MSG　=　Users(I,　1)　&　"　:　"　&　Users(I,　2)　&　vbCrLf
　　　　　　　Next
　　　　　　　MsgBox　"あなた以外の誰かがブックを開いています　:　"　& _
　　　　　　　　　　　　vbCrLf　&　MSG
　　　　　End　If
　　　End　Sub


　（解説）
　　　今開いているブックを開いている人が自分以外に誰かいるかを確認。
　　　ブックを指定するならば「ActiveWorkbook」を「Workbooks(ファイル名)」に
　　　してもよい。


－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

２．範囲内の図形の削除
　　参照URL


　（使用例）
　　　'===========================================================
　　　' 範囲内の図形の削除
　　　'===========================================================
　　　Sub　DeleteShape()
　　　　　Dim ShapTop As Double
　　　　　Dim ShapLeft As Double
　　　　　Dim ShapBotom As Double
　　　　　Dim ShapRight As Double
　　　　　

　　　　　'■指定セル範囲の上下左右の位置情報を取得
　　　　　With　WHX.Range("A15:E30")
　　　　　　　ShapTop = .Top
　　　　　　　ShapLeft = .Left
　　　　　　　ShapBotom = .Top + .Height
　　　　　　　ShapRight = .Left + .Width
　　　　　End　With
　　　　

　　　　　'■シート内のオブジェクト全てを確認し、範囲内なら削除
　　　　　For Each OBJ In ActiveSheet.DrawingObjects
　　　　　　　If Not OBJ Is Nothing Then
　　　　　　　　　With　OBJ
　　　　　　　　　　　If ShapTop <= .Top And ShapLeft <= .Left And _
　　　　　　　　　　　　ShapBotom >= .Top + .Height And ShapRight >= .Left + .Width Then
　　　　　　　　　　　　　.Delete
　　　　　　　　　　　End If
　　　　　　　　　End　With
　　　　　　　End　If
　　　　　Next
　　　End　Sub


　（解説）
　　　★「ShapBotom = .Top + .Height」　＝　上位置＋高さ
　　　★「ShapRight = .Left + .Width」　＝　左位置＋幅
　　　★「ShapTop <= .Top」
　　　　　　＝　オブジェクトの上位置が範囲の上位置より下
　　　★「ShapLeft <= .Left」
　　　　　　＝　オブジェクトの左位置が範囲の左位置より右
　　　★「ShapBotom >= .Top + .Height」
　　　　　　＝　オブジェクトの下位置が範囲の下位置より上
　　　★「ShapRight >= .Left + .Width」
　　　　　　＝　オブジェクトの右位置が範囲の右位置より左
　　

　　　※詳しくは下図参照※

　　　

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－


３．指定した文字列があったらその部分だけ文字を装飾する
　　＝　対象セル.Characters(Start:=*, Length:=*).Font.***
　　　　・・・Bold（太字）、ColorIndex（色）、Size（サイズ）など


　（使用例）
　　　'===========================================================
　　　' 指定した部分だけ文字を装飾する
　　　'===========================================================
　　　Sub FontDecoration()
　　　　　Dim LG As Long
　　　　　Dim I As Long
　　　　　Dim J As Long

　　　　　'■最終行まで回して該当したら太字にして文字色を変える
　　　　　LG = Range("A65536").End(xlUp).Row
　　　　　For I = 1 To LG
　　　　　　　'△見ているセルに「ABC」が含まれるか
　　　　　　　If Range("A" & I).Value Like "*ABC*" Then
　　　　　　　　　'◆セルの中のABCの部分を探す
　　　　　　　　　J = InStr(1, Range("A" & I).Value, "ABC")
　　　　　　　　　Range("A" & I).Characters(Start:=J, Length:=3).Font.Bold = True
　　　　　　　　　Range("A" & I).Characters(Start:=J, Length:=3).Font.ColorIndex = 10
　　　　　　　End If
　　　　　Next
　　　End Sub


　（解説）
　　　★「J = InStr(1, Range("A" & I).Value, "ABC")」
　　　　　→Instr(スタート、対象文字列、検索文字列）

　　　★「Range("A" & I).Characters(Start:=J, Length:=3).Font.Bold = True」
　　　　　→Range("A" & I)　＝　A列I行目のセルで
　　　　　→Start:=J　　　　＝　J番目の文字から
　　　　　→Length:=3　　　　＝　3文字分を
　　　　　→Bold = True　　　＝　太字にする
　　　　※ColorIndexの方も同じ意味合い


－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－


1番は作業中に組み込むというよりも使いたいファイルを誰が開いているのか
確認したい場合などに使えますね。
（まあ、サーバーから使用者探す方法が出来る場合はそっちの方が確実ですが）


2番はシート内の全てを一気に消すんでも特定の図形だけを消すんでもないけど
一部分だけ一気に消したい、という時に使えますね。

ちなみに私は実作業でも使いましたし作成途中などでも使いました。
図形の数が多いと便利です。


3番は何かしら検索した結果を目立たせる時などに使えますね。

全部じゃなくて一部だけ装飾したい、って意外にあると思うので
あれば便利かなと思います。