× [PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。 |
![]() |
Excelマクロのモジュールをそのまま貼り付け。
(会社とか家とか出先とかで見るため) 「Option Compare Binary」以下を標準モジュールに貼り付ければ、Myマクロ辞典に! 貼り付け後、「■Sub 」を「Sub 」に置き換えよう! ※公開している以上、利用は自由ですが、自己責任で。 Option Compare Binary Option Explicit ' 'その他マクロ ■Sub ファイルの起動時にマクロを実行する() 'auto_open() ←マクロ名 MsgBox "B5をアクティブにします。 " Range("B5").Activate '記述はなんでもいい End Sub ■Sub auto_openをデバッグする() 'シングルステップで実行する場合は[f8] Workbooks.Open("D:\My Documents\da Vinci出力\ファイル変換v1.xls").RunAutoMacros xlAutoOpen End Sub ■Sub ファイルを閉じる時にマクロを実行する() 'Sub auto_close() 'Sub Auto_Close() ※どちらでもOK '※マクロの Closeイベントで閉じる場合、実行されない。 '※マクロの Closeイベントを実行するときは、[ThisWorkbook]のコードウィンドウに記述する。 If vbYes = MsgBox("上書き保存しますか? ", vbYesNo + vbQuestion, "ファイルを終了") Then ThisWorkbook.Close True '保存して閉じる Else ThisWorkbook.Close False '保存しないで閉じる End If '※IF文の分岐内に“End”を入れても、Auto_Closeはキャンセルできないので注意。 End Sub ■Sub 確認ダイアログを非表示() Application.DisplayAlerts = False '非表示 Application.DisplayAlerts = True '表示 End Sub ■Sub クリップボートを空にする() Application.CutCopyMode = False End Sub ■Sub DoEvents関数() '発生したイベントがオペレーティングシステムによって処理されるように制御を戻します。 'DoEventsは、MS-WindowsがUNIXやLinux等のマルチタスクOSではなく、疑似マルチタスクであるため必要なものです。 '通常マルチタスクOSでは、同時に実行される各種のプログラムに対して処理に必要な時間と順序をOSが配分して '実行しますが、MS-Windowsではプログラムから処理が戻ってから(今回ではプロシージャが終了してから)、 '次のプログラムやキー入力、マウス入力イベント等を実行します。 'したがって、時間のかかる処理や無限ループなどがあると、他の処理が実行できなくなり、 '極端に全体の反応が遅くなったり、動かなくなったりします。 '#画面が白くなるのは、表示の更新が行われなくなるためです。 'そうなる事を防ぐ為、DoEventsを実行して、他のプログラムやイベント処理を実行させる必要があります。 '【使用例】 Dim i As Variant For i = 1 To 10 Cells(i, 3).Value = i DoEvents '←★ Next End Sub ■Sub DoLoop文() 'Do While 条件式 …条件式がtrueの間だけ処理を実行。 'Do Until 条件式 …条件式がtrueになるまで処理を実行。 'セルA1からシート終端セルまで、文字列"ABC"を探す Dim i As Long i = 1 Do While Cells(i, 1) <> "ABC" If i = Cells.Rows.Count Then 'シート終端に達したら、ループを抜ける Exit Do End If i = i + 1 Loop End Sub ■Sub ForNext文() 'For文は繰り返しの回数が決まっているとき、 'Do文は繰り返し回数が決まっていないときに使用すると、ソースの意味がわかりやすくなります。 'For Nextで使うカウンタ変数は、アルファベット小文字の「i」「j」「k」を使うのが一般的です。 'セルA1~セルA10 に値を入力する Dim i As Long For i = 1 To 10 Cells(i, 1).Value = i Next '■増減値を指定 For i = 1 To 10 Step 2 Cells(i, 1).Value = i Next '■ループアウト 'Exit Forステートメントを使用すると繰り返しを抜ける事が出来ます。 For i = 1 To 10 Step 2 If myCnt = 5 Then Exit For Cells(i, 1).Value = i Next End Sub ■Sub Sleepで処理を一時中断() 'Timerモジュール参照 End Sub ■Sub IF文の書き方() Dim a As Variant a = 10 'ふつうの書き方(処理ごとに改行) If a = 0 Then MsgBox "true(処理ごとに改行しています。)" Else MsgBox "false(処理ごとに改行しています。)" End If 'Else文を1行に記述 If a = 0 Then MsgBox "合ってる(Else文を1行に記述しています。)" Else: MsgBox "間違ってる(Else文を1行に記述しています。)" End If 'Else文を1行に記述(エラーになる例) If a = 0 Then MsgBox "合ってる(Else文を1行に記述しています。)" '真の処理文(Then以下)は次の行にしないと× Else: MsgBox "間違ってる(Else文を1行に記述しています。)" End If 'すべて1行で記述(処理がそれぞれ1つの場合。End Ifは記述しない) If a = 0 Then MsgBox "OK(すべて1行で記述)" Else MsgBox "NG(すべて1行で記述)" If a = 0 Then MsgBox "OK(すべて1行で記述/Elseの処理なし)" 'Elseの処理がないときはこれでもいいみたい 'If Not文 If Not ActiveSheet.Name Is "Sheet1" Then MsgBox "YES(If Not文)" Else MsgBox "NO" 'If xxx <> xxx ~ だと×なときがあるみたい '※ ElseIf を含む場合は、ふつうの書き方(処理ごとに改行)のみOK a = InputBox("数字を入れて") If a = 1 Then MsgBox "Yes" ElseIf a = 2 Then MsgBox "YesYes" Else MsgBox "No!" End If End Sub ■Sub メッセージBOXをIF文に利用する() 'MeaBoxの「メッセージBOXをIF文に利用する」参照 End Sub ■Sub CASE選択1() Select Case Range("A1").Value Case Is < 3 '演算した結果を比較演算子で指定(セルA1が"3未満") MsgBox "A" Case 5 '値を指定(Is = 5 でもOK) MsgBox "B" Case 7 To 9 '演算した結果を範囲で指定(セルA1が7~9) MsgBox "C" Case Else '上記に当てはまらない場合(Else) MsgBox "該当なし" End Select End Sub ■Sub CASE選択2() 'Select Caseステートメント ans% = MsgBox("確認しちください♪", vbYesNoCancel) Select Case ans% Case vbYes GoTo step1 '処理分岐(Yesなら行ラベル名「step1」を実行する) Case vbNo GoTo step2 Case vbCancel 'Case Elseでもよい GoTo step3 End Select step1: 'これを「ラベル(行ラベル)」と呼ぶらしい MsgBox "step1を実行します" 'その2 Select Case 変数 Case 値1 変数 = 値1の場合の処理 Case 値2 変数 = 値2の場合の処理 Case Else 変数 = 値1、変数 = 値2を満たさなかった場合の処理 End Select End Sub ■Sub CASE選択3_ファイル取込() Dim ans As Variant ans = MsgBox(f_type & "ファイルの取り込みを開始します。 ", vbOKCancel + vbQuestion, "CSVファイルの取り込み") Select Case ans Case vbYes Call CSVファイルを読み込む 'CSVファイル(集団型)を開く Case vbNo 個別型を開く2: 'ラベル f_type = "個別型" If vbYes = MsgBox(f_type & "ファイルの取り込みを開始します。 ", vbYesNo + vbQuestion, "CSVファイルの取り込み") Then Call CSVファイルを読み込む 'CSVファイル(個別型)を開く MsgBox "取込完了 ", vbInformation Exit Sub Else MsgBox "終了します。" & vbNewLine & f_type & "ファイルは取り込まれていません。 ", vbInformation, "取込終了" Exit Sub End If Case vbCancel Exit Sub End Select GoTo 個別型を開く2 End Sub ■Sub 処理分岐_GoToステートメント() '上記「CASE選択」も参照 MsgBox ("Gotoステートメントのテスト1") GoTo Label1 MsgBox ("Gotoステートメントのテスト2") '→実行されない Label1: 'これを「ラベル(行ラベル)」と呼ぶらしい MsgBox ("Gotoステートメントのテスト3") End Sub ■Sub 処理分岐_Callステートメント() 'プロシージャの呼び出し Call 枠線の表示切替 '「Sub 枠線の表示切替()」を呼び出す '※単に呼び出したいプロシージャ名を記述するだけで呼び出すこともできる 枠線の表示切替 'Gotoは、同じプロシージャ内。「処理分岐_GOTO」参照↑ End Sub ■Sub 文字コード変換() Dim st As ADODB.Stream Dim rowNo As Integer On Error GoTo Err 'ADODB.Stream生成 Set st = New ADODB.Stream 'Textモード st.Type = adTypeText '文字コード(Shift_JIS, Unicodeなど) st.Charset = "UTF-8" 'Streamのオープン st.Open 'ファイル読み込み st.LoadFromFile ("C:\test2.csv") rowNo = 1 'ファイルの終りまでループ Do While Not (st.EOS) '1行読み込み(readText(adReadAll):すべて読み込み) Worksheets("Sheet1").Cells(rowNo, 1).Value = st.ReadText(adReadLine) rowNo = rowNo + 1 Loop 'クローズ st.Close Set st = Nothing Exit Sub Err: Set st = Nothing 'エラー内容 MsgBox (Err.Description) End Sub ■Sub Debug_() '変数の値をイミディエイトに表示 Debug.Print f_path End Sub ■Sub Excelのバージョンを取得() MsgBox Application.Version 'バージョン 戻り値(文字列型) '2010 14.0 '2007 12.0 '2003 11.0 '2002 10.0 '2000 9.0 '97 8.0 '95 7.0 '5.0 5.0 End Sub ■Sub ファイルフォーマットを取得() MsgBox ActiveWorkbook.FileFormat '戻り値は、ヘルプ→Microsoft Visual Basic for Applications ヘルプ→「XlFileFormat 列挙」で検索、参照 End Sub PR |
![]() |
![]() |
|
![]() |