Excel VBA ノート(サンプルコード)

Hide Tamura の Excel VBA ノート

Excel VBA教室 2 マクロの設定 セキュリティ センター

bizvba_160Excel VBAを利用するには、マクロのセキュリティを設定しておきます。

ここでは、一番簡単な方法で説明します。


まずは、Excel 上部の「開発」タブを選択します。
「開発」タブが表示されていない場合は表示させてください。 




k2


「開発」タブの「コード」グループから、「マクロのセキュリティ」を選択します。

「セキュリティ センター」ダイアログボックスが表示されます。

「マクロの設定」で、「警告を表示してすべてのマクロを無効にする」を選択状態にして、「OK」ボタンを押します。


この方法が利用できない場合は、「Excel のオプション」からもセキュリティ センター(セキュリティ レベル)の設定が可能です。




 

Excel VBA教室 1 Excelの設定 開発タブを表示

bizvba_160

まず、Excel VBA を便利に利用する為に、Excel に、「開発」タブを追加しよう。
既に表示されている人は、ここは読み飛ばしてOK!






k1

① Excelの「ファイル」タブを選択
  左のメニューの一番下の「オプション」を選択 (一番下じゃない場合もあるかも?)
  「Excel のオプション」ダイアログボックスが表示されます

② 「Excel のオプション」ダイアログボックスの左のメニューから、「リボンのユーザー設定」を選択

③ 右の「リボンのユーザー設定」で、メインタブにある、「開発」にチェックを入れる

④「開発」 が追加された

この「開発」タブは、あると便利なので表示しておきましょう。




Excel VBA 教室

vba教室

bizvba_160
Excel VBA を使えるようになると、Excelの作業効率を上げることができます。

VBAを一から全て学ぶのではなく、必要な事だけ学べば良いと思う。

Excel VBA を使うことは、手段であり、目的じゃないから。

一緒に Excel VBA を学ぼう!



3 VBA(Visual Basic for Applications)とは
4 複数のマクロを続けて実行する(マクロを組み合わせて一つのマクロを作る)




 

 

Excel-VBA 入力セル間をEnterキーで移動したい。 セルのロックの解除 シートの保護「ロックされていないセル範囲の選択」 Selection.Locked = True ActiveSheet.EnableSelection = xlUnlockedCells

入力セル間をEnterキーで移動させたいことがあります。
入力箇所のみ選択ができ、その他セルは選択ができないようにします。

方法は、
特定のセルのみ、そのセルのロックを解除して、シートの保護をします。
シートの保護をする際、「ロックされていないセル範囲の選択」のチェックボックスにチェックを入れます。


■セルのロックの解除

ロックを解除したいセルの上で右クリックして、 サブメニューから「セルの書式設定(F)...」を選択。
表示された 「セルの書式設定」ダイアログボックスで、「保護」タブを選択。
「ロック」のチェックボックスのチェックを外す。

vba1


VBAでロックの解除を書く場合の例

    Range("F28").Select
    Selection.Locked = False

ロックする時は、FalseをTrueに。


■シートの保護で、「ロックされていないセル範囲の選択」のチェックボックスにチェックを入れる。

vba2

VBAで書く場合は

    ActiveSheet.Protect
    ActiveSheet.EnableSelection = xlUnlockedCells


これだけです。
Enterキーを押せば、次の入力セルに移動できます。


 

Excel-VBA ある文字より後ろの文字を全て取り出す InStr Mid vbTextCompare

「:」より後ろの文字を取り出す。 「:」は全角でも半角でもよし。

Sub test()

    Dim myText As String
    Dim myLong As Long
    
    '「:」は全角でも半角でも大丈夫だし、何文字目にあっても良い
    myText = "売掛金:ABC工業"
    
    
    ' myTxet(売掛金:ABC工業)の 1文字目から 「:」をテキストモード(vbTextCompare)で
    '検索して左から何文字目にあったかを返す
    myLong = InStr(1, myText, ":", vbTextCompare)
    
    '検索文字があれば(0文字目じゃなかったら)、Mid関数で検索文字の次以降を取り出す
    If Not (myLong = 0) Then
        msgbox Mid(myText, myLong + 1)
    End If

End Sub


 

Excel-VBA Excel2016でもExcel2013のVBAプログラム(マクロ)は動くか

今まで Excel2013をメインに使用していましたが、office365をインストールして、Excel2016 にしました。

Excel2013と、Excel2016は、ひとつのパソコンに共存させることができません。
下位バージョンのoffice製品はアンインストールさせる必要がありますので、Accessは古いバージョンのまま・・・なんてことは出来ませんので注意が必要です。
つまり、Office製品をすべて 2016にバージョンにアップデートすることになります。


心配していたことは、Excel2013用に作ったVBAプログラムが、Excel2016 でも問題なく動くかどうか。

テストした結果・・・問題なく動作しました。

ユーザーフォーム、CSV書き出し/読み込み、ファイル操作などなど。どれも問題なし。


今後、Excel2016特有のトラブルが発生した場合には、このブログに書きたいと思います。



参考
Excel2016 の Application.Version は、16.0 でした。



Excel-VBA リストボック(ListBox)に絞り込み機能を追加 Find

uf3


リストボックスの上に絞り込み用のTextBoxを配置し、「ふりがな」で絞り込みを行う。
例では、商品テーブルの商品に「ふりがな」列を作っておき、絞り込みの文字(ひらがな)と比較する。


TextBoxの文字を一文字入力する度にListBox内のリストが絞り込まれる。逆に一文字づつ消しても同様。
全ての文字を消した場合には、ListBoxを初期状態へ再表示して全てのリストを表示する。

元の商品リストと別に、絞り込み用の表をプログラム内で作成し、それをListBoxに表示し直すので、元のリストは壊れない。


以下は、TextBoxに入力してListBoxが絞り込まれるプログラム。

===========================

Private Sub TextBox1_Change() 
    Dim r As Long
    Dim lngEndRow As Long

    Application.ScreenUpdating = False
    
    'テキストボックが空だったら、ListBoxに全てのリストを表示して終了
    If TextBox1.Text = "" Then
    
        r = Application.Rows.Count
        lngEndRow = Sheets(Sht_work2).Cells(r, "A").End(xlUp).Row
    
        If lngEndRow < 2 Then
            ListBox2.RowSource = ""
        Else
            ListBox2.RowSource = Sht_work2 & "!A2:B" & lngEndRow
        End If
    
        Exit Sub
    End If
    
    'テキストボックに入力があったら、絞り込みを行う
    Call 商品情報をふりがな入力で絞り込みLB1
    
End Sub

===========================

Sub 商品情報をふりがな入力で絞り込みLB1() 
    Dim strActiveCellAddress As String
    Dim strThisSheetName As String
    
    Dim r As Long
    Dim lngEndRow As Long
    Dim i As Long
    
    Dim Serch_ID As String
    Dim Dat_SerchArea As String
    Dim firstAddress As String
    Dim c As Range
    
    Application.ScreenUpdating = False
    
    strActiveCellAddress = ActiveCell.Address
    strThisSheetName = ActiveSheet.Name
    
    '--------------------------------------------------
    '       振込情報をワークシートにコピー
    '--------------------------------------------------
    
    '商品リストの最終行を求める
    r = Application.Rows.Count
    lngEndRow = Sheets(Sht_work2).Cells(r, "A").End(xlUp).Row

    '商品リストがない→終了
    If lngEndRow < 2 Then
        ListBox2.RowSource = ""
        Exit Sub
    End If

    '絞り込んだデータはJ:K列にコピーするので、コピー先をクリアしておく
    Sheets(Sht_work2).Columns("J:K").ClearContents

    '絞り込みキーワードをTextBoxから得る
    Serch_ID = TextBox1.Text
    
    '検索先の列を指定
    Dat_SerchArea = "C1:C" & lngEndRow

    '--------------------------------------------------
    ' TextBox1のTextと ふりがな が部分一致したらコピー
    '--------------------------------------------------
    
    i = 1
    
    '商品の表タイトルだけ先に絞り込み表へコピー
    Sheets(Sht_work2).Range("A" & i & ":C" & i).Copy
    Sheets(Sht_work2).Range("J" & i).PasteSpecial Paste:=xlValue
    Application.CutCopyMode = False
    
    '見出し部分を消して、見出し行から検索しないと並び順が狂う。
    Sheets(Sht_work2).Range("C1").ClearContents
    
    '絞り込み検索して部分一致した商品データを、絞り込み後の表へコピーしていく
    With Worksheets(Sht_work2).Range(Dat_SerchArea)
        
        Set c = .Find(Serch_ID, LookIn:=xlValues, lookat:=xlPart, matchbyte:=False)
        If Not c Is Nothing Then
        
            firstAddress = c.Address
            i = i + 1
            
            Sheets(Sht_work2).Range("A" & c.Row & ":C" & c.Row).Copy
            Sheets(Sht_work2).Range("J" & i).PasteSpecial Paste:=xlValue
            Application.CutCopyMode = False
                      
            Do
                
                Set c = .FindNext(c)
                
                If c.Address <> firstAddress Then
                    i = i + 1
                    Sheets(Sht_work2).Range("A" & c.Row & ":C" & c.Row).Copy
                    Sheets(Sht_work2).Range("J" & i).PasteSpecial Paste:=xlValue
                    Application.CutCopyMode = False
                End If
            
            Loop While Not c Is Nothing And c.Address <> firstAddress

        End If
    
    End With

    '絞り込み後の表の最終行を確認し、一致したデータあった場合は、ListBoxに再表示
    lngEndRow = Sheets(Sht_work2).Cells(r, "J").End(xlUp).Row
    If lngEndRow < 2 Then
        ListBox2.RowSource = ""
    Else
        ListBox2.RowSource = Sht_work2 & "!J2:K" & lngEndRow
    End If
    
    Sheets(strThisSheetName).Select
    Range(strActiveCellAddress).Select
    
End Sub

Excel-VBA リストボック(ListBox)に複数の項目(フィールド)を登録、表示上は特定の項目のみにする ListBox ColumnWidths ListBox1.List(行,列)

UserFormのイニシャライズの際にA列~H列の8つの項目のリストをListBox1に登録。
UserForm3.ListBox1.RowSource = Sht_work1 & "!A2:H" & (lngEndRow - 1)
※Sht_work1 と lngEndRow は変数。

その際に、左から2つの項目(振込先コード、振込先名)だけリストに表示。
ListBox1 のプロパティで、ColumnWidths を次のように設定

30 pt;150 pt;0 pt;0 pt;0 pt;0 pt;0 pt;0 pt


ListBox1のリストをクリックした時には、ListBoxに表示していないデータもセルに転記します。

Private Sub ListBox1_Click()
    Dim lngListIndex As Long

    Application.ScreenUpdating = False

    lngListIndex = Me.ListBox1.ListIndex

    Cells(ActiveCell.Row, "F").Value = Me.ListBox1.List(lngListIndex, 0) '振込先コード
    Cells(ActiveCell.Row, "G").Value = Me.ListBox1.List(lngListIndex, 1) '振込先名
    Cells(ActiveCell.Row, "M").Value = Me.ListBox1.List(lngListIndex, 3) '銀行
    Cells(ActiveCell.Row, "N").Value = Me.ListBox1.List(lngListIndex, 4) '支店
    Cells(ActiveCell.Row, "O").Value = Me.ListBox1.List(lngListIndex, 5) '種
    Cells(ActiveCell.Row, "P").Value = Me.ListBox1.List(lngListIndex, 6) '口座番号
    Cells(ActiveCell.Row, "Q").Value = Me.ListBox1.List(lngListIndex, 7) '口座名

End Sub


Excel-VBA UserFormとExcelブックを並べて表示 Application.Left Application.Top

userfrom3


Sub UF3Show() '★

    'ユーザーフォームを表示する
    UserForm3.Show
    
    '==================================================
    
    ' ウインドウの位置とユーザーフォームの位置の調整
        
    '==================================================

    'Excel2013より前のバージョンはウインドウの中でブックを最大化する
    '(Excel2013からはブックごとにウインドウが異なる)
    If Application.Version < 15 Then
        ActiveWindow.WindowState = xlMaximized
    End If

    'WindowStateをノーマルにしてフローティング状態にする(最大でも最小でもない)
    Application.WindowState = xlNormal

    'Excelウインドウの左にらUserFormの幅分(220)の隙間を空ける
    If Application.Left < 220 Then Application.Left = 220

    '------------------------------
    'UserForm3の表示位置の設定

    'UserFormをExcelウインドウより少し下げる
    UserForm3.Top = Application.Top + 5
    
    'UserFormをExcelウインドウからUserFormの幅分分(220)だけ左に表示
    UserForm3.Left = Application.Left - 220

End Sub

 

Excel-VBA 銀行口座名から振込用のカタカナ口座名を作る Phonetic オブジェクト, Replace関数

銀行口座名の「ふりがなテキスト文字列」から、振込用のカタカナ口座名を作る。
㈱や㈲は、カ)や、ユ)に変換する必要がある。


Dim Kouzamei As String

'入力した際の 「ふりがなテキスト文字列」が無ければ終了
If Cells(ActiveCell.Row, "C").Phonetic.Text = "" Then Exit Sub

'振込用口座名入力がまだ無い場合に行う。既に入力されていたら何もしない。
If Cells(ActiveCell.Row, "I").Value = "" Then
    
    '口座名をフリガナに変換して変数にもつ(「ふりがなテキスト文字列」を使用する)
    Kouzamei = StrConv(Cells(ActiveCell.Row, "C").Phonetic.Text, vbKatakana)

    '振込用口座名の場合は、㈱や㈲をカタカナ表記に変える
    If Right(Kouzamei, 1) = "㈱" Then Kouzamei = Replace(Kouzamei, "㈱", "(カ")
    If Left(Kouzamei, 1) = "㈱" Then Kouzamei = Replace(Kouzamei, "㈱", "カ)")
    If Right(Kouzamei, 4) = "(カブ)" Then Kouzamei = Replace(Kouzamei, "(カブ)", "(カ")
    If Left(Kouzamei, 4) = "(カブ)" Then Kouzamei = Replace(Kouzamei, "(カブ)", "カ)")
    If Right(Kouzamei, 4) = "(カブ)" Then Kouzamei = Replace(Kouzamei, "(カブ)", "(カ")
    If Left(Kouzamei, 4) = "(カブ)" Then Kouzamei = Replace(Kouzamei, "(カブ)", "カ)")
    
    If Right(Kouzamei, 1) = "㈲" Then Kouzamei = Replace(Kouzamei, "㈲", "(ユ")
    If Left(Kouzamei, 1) = "㈲" Then Kouzamei = Replace(Kouzamei, "㈲", "ユ)")
    If Right(Kouzamei, 4) = "(ユウ)" Then Kouzamei = Replace(Kouzamei, "(ユウ)", "(ユ")
    If Left(Kouzamei, 4) = "(ユウ)" Then Kouzamei = Replace(Kouzamei, "(ユウ)", "ユ)")
    If Right(Kouzamei, 4) = "(ユウ)" Then Kouzamei = Replace(Kouzamei, "(ユウ)", "(ユ")
    If Left(Kouzamei, 4) = "(ユウ)" Then Kouzamei = Replace(Kouzamei, "(ユウ)", "ユ)")
    
    '振込口座名を表示する
    Cells(ActiveCell.Row, "I").Value = Kouzamei

End If

 


記事検索
Excel VBA ノートについて(注意事項)
このExcel VBA ノートは、Hide Tamura の個人的なVBAノートです。プログラムを再利用したり、コピペで入力の手間を省く為に作ったネット上のノートです。 その為、詳しい解説は書いておりません。エラー等のトラブルには責任は負いません。利用者の環境に合わせて書き換えてご利用ください。
ExcelVBA教室
Excel VBA 担当 Hide Tamura

Excel95? マクロシートがあった頃からExcelVBAを独学で利用しています。現在は、様々な企業様からVBAによる業務効率UPの為のお仕事を頂いております。既にお使いになっているファイルにVBAを利用することで、作業が楽になったり、時間も大幅に短縮されたなど、大変喜ばれています。

■VBA Expert
VBA Expert Standard Crown
ExcelVBA Standard(Odyssey)
Access VBA Standard(Odyssey)
Excel2002 VBA Standard(日本VBA協会)
■MICROSOFT OFFICE USER SPECIALIST
Microsoft Excel version2002 Expert
Microsoft Excel version2002


最新記事
Excelで作る経営計画
Excelで利益計画を立てましょう!会社にいくらの利益が必要で、その為の売上高は?

Excelで作る経営計画
Excel 関数 ノート
Excel関数を中心に、Excelの便利機能や、意外としらない使い方など書いていきます。

Excel 関数 ノート
Access VBAノート
Hide Tamura の個人的なVBAノートです。

頻繁に使うVBAコードなどを記録しコピペして使う為に作りました。お役に立てるようでしたら、お使いください。

Access VBAノート
アクセスカウンター

    • ライブドアブログ