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

Hide Tamura の Excel VBA ノート

Excel-VBA 並べ替え用の「ふりがな」を隣のセルに自動表示。 Phonetic オブジェクト, Replace関数

並べ替え用の「ふりがな」を隣のセルに自動表示します。

指定されたセルの「ふりがなテキスト文字列」を右隣のセルに表示します。
(コピーした場合など、指定されたセルに「ふりがなテキスト文字列」が無いこともあります。)

方法
まず、指定したセルに「ふりがなテキスト文字列」があるかどうか。
あれば、「ふりがなテキスト文字列」を変数に入れる。
並べ替えには、変数から、㈱や㈲などは邪魔なので消す。
右隣のセルに、ふりがなを表示する。
ただし、並べ替えに適した「ふりがな」を手入力している場合もあるので、既に入力があれば、なにもしない。


Dim Furigana As String

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

'ふりがな列のセルに入力が無ければ、以下を行う(既に手入力されていたら何もしない)
If Cells(ActiveCell.Row, "D").Value = "" Then
    
    ' 「ふりがなテキスト文字列」を変数に持つ
    Furigana = StrConv(Cells(ActiveCell.Row, "C").Phonetic.Text, vbHiragana)
    
    '並べ替えの際に邪魔になる ㈱や㈲を消す
    Furigana = Replace(Furigana, "㈱", "")
    Furigana = Replace(Furigana, "(株)", "")
    Furigana = Replace(Furigana, "㈲", "")
    Furigana = Replace(Furigana, "(有)", "")
    Furigana = Replace(Furigana, "(有)", "")
    Furigana = Replace(Furigana, "(かぶ)", "")
    Furigana = Replace(Furigana, "(かぶ)", "")
    Furigana = Replace(Furigana, "(ゆう)", "")
    Furigana = Replace(Furigana, "(ゆう)", "")
    
    'ふりがなを ふりがな列に表示する
    Cells(ActiveCell.Row, "D").Value = Furigana

End If


Excel-VBA セル範囲を検索して関連する複数のデータを転記 Range.Find メソッド(VLOOKUPやHLOOKUPは使わない)

コード番号を入力することで、複数の関連情報を転記する時に利用します。
使用頻度の高く、重要度の高いサンプルコードです。

ExcelVBAリファレンスに「Findメソッド」の使用例が次のように出ています。

------------------------------
セル範囲内で特定の情報を検索します。

シート 1 のセル範囲 A1:A500 で、値に 2 が含まれているセルを検索し、その値を 5 に変更します。

With Worksheets(1).Range("a1:a500") 
    Set c = .Find(2, lookin:=xlValues) 
    If Not c Is Nothing Then 
        firstAddress = c.Address 
        Do 
            c.Value = 5 
            Set c = .FindNext(c) 
        Loop While Not c Is Nothing And c.Address <> firstAddress 
    End If 
End With
------------------------------

上記の例から、次のように書き換えて利用しています。

アクティブシートに振込先コードを入力し、振込先情報シートから関連情報を転記する例です。

Public Const Sht_furikomi As String = "振込先"

Sub 振込先コードto振込先情報()
    
    '検索に利用する変数
    Dim Serch_ID As String
    Dim Dat_SerchArea As String
    Dim c As Range
    
    Application.ScreenUpdating = False
        
    '振込先情報シートで検索するセル範囲(振込先コードがある列)
    Dat_SerchArea = "B:B"
    
    '検索する振込先コード番号を取得
    Serch_ID = ActiveSheet.Range("F" & ActiveCell.Row).Value

    'Serch_ID が無ければ終了(Val関数で0なら入力なしとする)
    If Val(Serch_ID) = 0 Then Exit Sub
                                                        
    With Worksheets(Sht_furikomi).Range(Dat_SerchArea)
        
        'lookat:=xlWhole で完全一致、xlPart なら部分一致
        Set c = .Find(Serch_ID, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
                                        
            '振込先情報シートから、アクティブシートに関連情報を転記する
            With ActiveSheet
                .Range("G" & ActiveCell.Row).Value = Sheets(Sht_furikomi).Range("C" & c.Row).Value '振込先
                .Range("M" & ActiveCell.Row).Value = Sheets(Sht_furikomi).Range("E" & c.Row).Value '銀行
                .Range("N" & ActiveCell.Row).Value = Sheets(Sht_furikomi).Range("F" & c.Row).Value '支店
                .Range("O" & ActiveCell.Row).Value = Sheets(Sht_furikomi).Range("G" & c.Row).Value '種
                .Range("P" & ActiveCell.Row).Value = Sheets(Sht_furikomi).Range("H" & c.Row).Value '口座番号
                .Range("Q" & ActiveCell.Row).Value = Sheets(Sht_furikomi).Range("I" & c.Row).Value '口座名
            End With
        
        End If
    
    End With
    
End Sub

Excel-VBA データ入力便利機能: 表の最終列まで来たら、次行の開始列へ移動し、罫線も自動で追加する Worksheet_SelectionChange

まず・・・

あるタイミングで、Enterキーを押した後の、セルの移動方向を右に行くように変更しておきます。

    'セルの移動方向 右
    Application.MoveAfterReturnDirection = xlToRight

元に戻す時は、

    'セルの移動方向 下(標準)に戻す
    Application.MoveAfterReturnDirection = xlDown
    

------------------------------------------------------------------------

下の例では、表のL列まで来たら、次行のC列に移動し、罫線も自動で追加しています。

プログラム書く場所は、ワークシート・モジュール内
「VBAProject」→「Microsoft Excel Objects」→「Sheet1(など)」

「Sheet1」モジュールの上部左のリストから「Worksheet」を
「Sheet1」モジュールのの上部右のリストから「SelectionChange」を選択します。

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

        Select Case ActiveCell.Column
    
            'L列(12) まで来たら(表はK列まで)
            Case 12

                '最左へスクロールを動かす
                ActiveWindow.ScrollColumn = 1
                
                Call 罫線引き
    
        End Select
        
End Sub

------------------------------------------------------------------------

以下は、標準モジュールの中に書きます。
「VBAProject」→「標準モジュール」→「Module1(など)」

Sub 罫線引き()
        
    Range(Cells(ActiveCell.Row + 1, "C"), Cells(ActiveCell.Row + 1, "K")).Select
    
    Call 罫線

    '選択セル範囲の一番目を選択(C列)
    Selection.Cells(1).Select

End Sub

Sub 罫線()

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Color = -13312
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Color = -13312
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Color = -13312
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Color = -13312
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Color = -13312
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Color = -13312
        .TintAndShade = 0
        .Weight = xlThin
    End With

End Sub

上の「罫線」のプログラムについては、「マクロの記録」機能を使って自動で作成するのが楽です。その中から、セル範囲の選択部分を消去します。セル範囲の選択だけ変更することで、この部分は何度も利用できますから。


Excel-VBA フォントの色によって処理を変える ActiveCell.Font.Color

セルのフォントの色によって処理を変えたいという質問がありまして・・・

Sub Macro1()

    'フォントの色によって処理を変える
    Select Case ActiveCell.Font.Color
    
        Case vbBlack
        
            MsgBox "黒・自動"
                
        Case vbWhite
        
            MsgBox "白"
        
        Case vbRed
    
            MsgBox "赤"
    
    End Select
    
End Sub


Excel-VBA ソフト作り パブリック定数 : ワークシート名や、表の見出し行(列)番号、特定セル番号 の変更に備える Public Const

ワークシート名や、表の見出し行(列)番号、特定セルなどは、変更になる場合があります。

その際には、「全て置換」で書き換えするのではなく、予めパブリック定数にしておく事で、修正を一カ所で済むようにしておく。

私の場合は、新たに標準モジュールを挿入し、オブジェクト名を「Module0」に変更して、その中にマトメて設定しています。


例えば・・・ Module0 の中を、

------------------------------------------------------

'ワークシート定数
Public Const Sht_data As String = "データ"
Public Const Sht_furikomi As String = "振込先"
Public Const Sht_shohin As String = "商品"
Public Const Sht_work1 As String = "work1"
Public Const Sht_work2 As String = "work2"
Public Const Sht_CSV As String = "csv"

'ワークシート行設定(見出し行)
Public Const TitleRow_Sht_Data As Long = 6
Public Const TitleRow_Sht_furikomi As Long = 3
Public Const TitleRow_Sht_shohin As Long = 3

'フラグ用変数
Public blnSelectionChangeFlag As Boolean
Public blnCellColorFlag As Boolean

------------------------------------------------------

のように。



パブリック以外で使用する定数・変数は、各モジュール内、各プロシージャ内で宣言しています。
これで、急に、シート名が変更になっても慌てません。(^^♪

 

Excel-VBA ソフト作り ファイルを開く時に自動で動くプログラム Workbook_Open Workbook_BeforeClose Auto_Open Auto_Close

ファイルを開く時に自動で動いて欲しいプログラムがあります。

例えば・・・

ファイルを起動した時には、必ず最初に表示させたいワークシートがある場合。
Enterキーを押した時にセルを移動する方向を、下方向ではなく右方向にしたい場合。
ユーザーフォームを表示させたい場合。
などなど。

下の例では、メッセージボックスを表示させていますが、ここに動かしたい処理を書きます。


ファイルが開く時に自動で動くプログラム(2つあります)

Private Sub Workbook_Open()
    MsgBox "ワークブック オープン"
End Sub

Sub Auto_Open()
    MsgBox "オート オープン"
End Sub

動く順番は、Workbook_Open の次に、Auto_Openです。



ファイルが閉じる時に自動で動くプログラム(2つあります)

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    MsgBox "ワークブック クローズ"
End Sub

Sub Auto_Close()
    MsgBox "オート クローズ"
End Sub

動く順番は、Workbook_BeforeClose の次に、Auto_Closeです



Workbook_Open と、Workbook_BeforeClose を書く場所

標準モジュール内ではなく、
「VBAProject」→「Microsoft Excel Objects」→「ThisWorkbook」の中に書きます。

「ThisWorkbook」の上部左のリストから「Workbook」を
「ThisWorkbook」の上部右のリストから「Open」「BeforeClose」を選択します。



Auto_Open と、Auto_Close を書く場所

標準モジュールの中に書きます。
「VBAProject」→「標準モジュール」→「Module1(など)」の中に書きます。



私は、Auto_Open が動作しなかった経験があり、それ以来、Workbook_Open と、Workbook_BeforeClose のみを利用しています。

Excel-VBA トラブル解決方法:Excelを閉じると「VBAProject パスワード」が表示される(DropBox使ってる?)

突然、Excelを閉じると「VBAProject パスワード」が表示されるようになりました。

このトラブルの解決方法について

発生条件 Excel

Excel VBA を保護するため、プロジェクトのプロパティに保護(プロジェクトのプロパティ表示のためのパスワード)をかけている場合。
UserFormを利用している場合。

発生パソコンの共通点

この現象が起きた全てのパソコンに共通して DropBox がインストールされていた。

解決方法

DropBoxを一時的に終了させてみると、この問題は解消しました。
アンインストールまでする必要はありません。

DropBox の終了方法

タスクバーの右に小さいDropBoxのアイコンがありますので、それをクリックして、歯車のようなアイコンからメニューを表示させて、[DropBox を終了] を選択すると、終了します。
再度、DropBox を利用状態にするには、スタートメニューからDropBoxを起動できます。

想像ですが・・・

最近、DropBox フォルダの中の Excelファイルを直接起動してみると、ファイルの右にアイコンが表示されて、なにやら機能が追加されています。DropBox は、Excel に関連するAPIなどを利用しているのかもしれませんね。

プロジェクトのプロパティに保護をかけないという方法

この現象が起きる条件が、「Excel VBA を保護するため、プロジェクトのプロパティに保護(プロジェクトのプロパティ表示のためのパスワード)をかけている場合」 なので、特に必要がなければ、パスワードをかけないこと。
そうれば、DropBox を利用していても問題は発生しませんから。(^^♪


以上です。
 

Excel-VBA CSVファイルを書き出す時にはセル内の改行に注意 Chr(10) Replace

CSVファイルを書き出す時には、セル内に改行がある場合があるので注意が必要です。
CSVファイルの行中の思わぬ場所で改行されてしまいます。

改行は、vbCr  vbCrLf  vbLf  vbNewLine  Chr(10)  など色々な書き方がありますが、セル内の改行を取る時には、Chr(10) を消します。

Chr(10) を取ると、改行が無くなるので、読み難くなる為、スペースに置き換えています。

以下、Replace関数を使って、Chr(10) を " " に置き換えている例です。


Dim i As Long
Dim lngEndRow As Long, r As Long

    r = Application.Rows.Count
    
   'CSV用データで、金額の入っている行を最終行とする
    lngEndRow = Sheets(Sht_work1).Cells(r, "BP").End(xlUp).Row

    For i = 1 To lngEndRow
        
        '摘要中の改行コードを消去して1行に戻す
        Sheets(Sht_CSV).Cells(i, "Y").Value = Replace(Sheets(Sht_CSV).Cells(i, "Y").Value, Chr(10), " ")
    
    Next i


以上
 
 

Excel-VBA VBAのお仕事。VBAで稼ぐ!

bizvba_160このブログを訪問をされた方の多くは、VBAについて調べていて、偶然にこのブログに辿り着いたのでしょう。  っと、いう事は、既にVBA利用者という事ですね。

自分の仕事を楽にする為だったり、職場の仲間に頼まれたり、仕事として依頼を受けているのかもしれませんね。

私の場合は、その全てです。(^^♪

「せっかくVBAを勉強しているのだから、これで少しは稼ぎたい」 と思っている人も多いのではないでしょうか?

私は、仕事(有料)としてもVBAを書いています。

ほとんど紹介で仕事が入ってきていますが、Excel95 だったかな? マクロシートがあった頃からなので、かなり長いことやってますね。(^^♪


仕事でVBAを書いていると言っても、特に詳しいVBAの知識を持ってはいるわけではありません。

きっと、このブログを見ている皆さんと同じように、書籍や、VBE(Visual Basic Editor)のヘルプで調べたり、ネットで調べたり。
(ネットで検索していたら、自分のブログが検索されて、そこに知りたい事が書いてあった事も。 (^^♪  )

VBA以外のプログラムは、全く分かりません。
(少し勉強しましたが、難しくて諦めました。 (^^♪ )



はじめは、私のVBAを使ったファイルを見たある会社からオリジナルソフトをVBAで作りたいと依頼が入りました。

そのソフトは、その会社の顧客(会社)に使わせる物であった為、多くの会社が使うことになりました。その為、それらの会社からも、「自社で使っているファイルもVBAで便利にしてもらいたい」 と、新たな依頼が入るようになりました。

ひとつのソフトが完成するまでの間には、色々な機能追加の要望が依頼者から出てきます。もっと便利に!もっと便利に!と思うのでしょう。ようやく完成した後も、機能追加、改良、関連ソフトの依頼などが入ってきます。

私の経験では、特別なソフトをExcelで作ろうというのでなければ、ご要望の多い機能は、だいたい共通していて、それらのプログラムを一通りマスターすれば、仕事として受けられるようになると思います。(^^♪ 

既にお使いになっているファイルに、VBAを利用することで作業が楽になり、時間も大幅に短縮されたなら、そのプログラムは大変喜ばれます。








   つづく・・・

   のんびり書いてます。
  
   別の記事に続けず、この記事を書き換えて更新します。


Excel-VBA ハイフンとカンマによる数値範囲の取得(例:1-20,30,40-50) 印刷範囲やCSV書き出し範囲で利用 Split

ユーザーフォームの TextBox3 に入力されたデータ
1-20, 30, 40-50, 70,
から、1以上20以下、30、40以上50以下、70 と導き出す事で、印刷範囲やCSV書き出し範囲として利用する
文字や空白、ゼロは無視する事で、余計なカンマにも対応

Sub csvtest()
    Dim tmp As Variant, tmp2 As Variant
    Dim i As Long
    Dim lngS As Long, lngE As Long
    Dim strTextBox As String
    
    Dim lngInStr As Long
    
    '-------------------------
    
    strTextBox = Me.TextBox3.Text
    
    If strTextBox = "" Then
        MsgBox "入力データありません", vbExclamation
        Exit Sub
    End If
    
    '配列に区切り文字「,」のデータを所得
    tmp = Split(strTextBox, ",")
    
    For i = 0 To UBound(tmp)
    
        '-------------------------
        
        'その配列文字を、再度、区切り文字「-」で別の配列に取得
        lngInStr = InStr(tmp(i), "-")
    
        '配列に「-」があったら(範囲指定がある)
        If Not (lngInStr = 0) Then
            
            tmp2 = Split(tmp(i), "-")
        
            lngS = Val(tmp2(0))
            lngE = Val(tmp2(1))
        
            '開始数字より終了数字の方が大きくないといけない
            'ゼロではいけない
            If Not (lngS < lngE) Or lngS = 0 Or lngE = 0 Or UBound(tmp2) > 1 Then
                MsgBox "設定に誤りがあります", vbExclamation
                Exit Sub
            End If
        
            MsgBox lngS & "以上 " & lngE & "以下", vbInformation
        
        '配列に「-」が無かったら(範囲指定がない)
        Else
        
            'ゼロではいけない
            If Not (Val(tmp(i)) = 0) Then
                MsgBox Val(tmp(i)), vbInformation
            End If
        
        End If
    
    Next i

End Sub

 


記事検索
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ノート
アクセスカウンター

    • ライブドアブログ