アーカイブ

‘VBA’ タグのついている投稿

線形探索と二分探索をVBAで

2011 年 7 月 6 日 コメントはありません

線形探索(逐次探索)と二分探索をVBA(Excel)で行う方法です。

それぞれサンプルを示します。
ここではExcelのシートのA列の1行から40行まで昇順の数値が入っている場合に、ある数値を探し、その行番号を表示することにします。 続きを読む…

カテゴリー: Excel タグ: ,

複数のExcelファイルを1枚にまとめるマクロ

2011 年 7 月 6 日 コメントはありません

複数のExcelファイルの内容を1枚のシートにまとめるには、コピー＆ペーストを繰り返せばよいのですが、数が多くなると面倒です。
マクロで実行する方法を考えました。
あるフォルダに保存されている複数のExcelファイルとそのシートをすべて取得し、別の1枚のシートにまとめます。

ただし制限があります。
シートのレイアウトやサイズがすべて同じならばコピー＆ペーストでよいのですが、そうとは限らないので、範囲をあらかじめ決めて、その範囲のセルの内容をテキスト形式で取得します。
つまり書式は無視されます。
また1枚のシートにまとめるときに左端にファイル名とシート名をセットします。
無駄な行を削除するために並び替えたりしてもすぐに復元できます。

サンプルは前半と後半に分かれます。
Excelファイルには「matome」というシートを作っておきます。 続きを読む…

カテゴリー: Excel タグ: ,

Wordで1ページずつPDFで保存するマクロ

2011 年 7 月 5 日 コメントはありません

Wordで作成した文書はPDFで保存することができます。
ページを指定することで、特定の部分だけをPDFにすることもできます。
1ページずつ指定すれば、各ページをPDFで保存することができますが、ページ数が増えるとなかなか面倒です。

これをマクロで実行させる方法を考えました。Word2007で確認しました。 続きを読む…

カテゴリー: Word タグ: ,

複数のWord文書に連続して処理を施すマクロ

2011 年 6 月 30 日 コメントはありません

既にできているWord文書に対して一括して処理をしたいことがあると思います。
表紙に通し番号を入れたり、会社名や担当者名が変わったので置換したり、という場面です。

そのためのマクロを考えてみました。 続きを読む…

カテゴリー: Word タグ:

Wordファイルの透かしを削除するマクロ

2011 年 6 月 29 日 コメントはありません

Wordファイルの透かしを削除するには次のようにします(Word2007)。

  1. ページレイアウト-ページの背景-透かしを選択。
  2. 透かしの削除を選択。

これをマクロで実行する方法を考えました。
複数のWord文書に連続して処理を施すマクロに応用することもできます。 続きを読む…

カテゴリー: Word タグ: ,

Wordマクロで「ファイルアクセス権のエラー」

2011 年 6 月 29 日 コメントはありません

Wordマクロ(VBA)でこんなエラーが出ました。

「実行時エラー’5487′ ファイルアクセス権のエラーのため保存できません。」

今回のケースでは、ファイル名に改行が入っていました。「エラーメッセージと違うじゃないか！」と思いますが、広い意味ではそうなのでしょう。

サンプルは次の通りです。

Sub test()
    temp = ActiveDocument.Paragraphs(5).Range
    temp = Mid(temp, 1, Len(temp) - 1)
    fn = temp & ".doc"
    ActiveDocument.SaveAs (fn)
End Sub

アクティブなWord文書の5番目の段落の文字列に「.doc」を追加し、これをファイル名として保存する、というものです。
「Pragraphs」を使うと段落を取得することができるのですが、改行を含んでしまいます。
そこで「temp = Mid(temp, 1, Len(temp) – 1)」のようにして右端の文字(改行)を除きます。
これで正しく処理されました。

カテゴリー: Word タグ: ,

SelectCaseとIfで速いのはどっち？

2011 年 6 月 16 日 コメントはありません

VBAで、値によって違った処理をする場合には、Ifを使うのが普通ですが、値が多く選択肢が多い場合にはSelectCaseを使います。また単純に値を返すだけならば配列変数を使うかもしれません。
使いやすいものを使えばよいと思いますが、処理時間はどうでしょうか。

サンプル1 – 配列変数

Function test1(num)
    Dim a(100)
    a(0) = 404
    a(1) = 194
    省略
    a(99) = 547
    test1 = a(num)
End Function

サンプル2 – SelectCase

Function test2(num)
    Select Case num
        Case 0: temp = 404
        Case 1: temp = 194
        省略
        Case 99: temp = 547
    End Select
    test2 = temp
End Function

サンプル3 – If

Function test3(num)
    If num = 0 Then temp = 404
    If num = 1 Then temp = 194
    省略
    If num = 99 Then temp = 547
    test3 = temp
End Function

どのサンプルも、あらかじめセットした100個の適当な数から、n番目の数を返すというものです。
サンプル1は、配列変数にセットした値を返します。見た目は最もシンプル。
サンプル2は、SelectCaseを使った場合です。場合分けの場合はこれを使うのが一般的です。
サンプル3は、Ifを使った場合です。

これらを1000万回繰り返したときの実行時間を調べました。

サンプル 時間
配列変数 36秒
SelectCase 25秒
If(単純) 52秒

SelectCaseを使った場合が最も速いという結果になりました。
Ifのサンプルは、If行を全部チェックして値が一致するものを探すので時間がかかります。SelectCaseは一致した場合、その後のケースはチェックしません。

このIfのサンプルは書き方が酷すぎるのでちょっと変えてみました。

サンプル4 – If(終了)

Function test4(num)
    If num = 0 Then test4 = 404: Exit Function
    If num = 1 Then test4 = 194: Exit Function
    省略
    If num = 99 Then test4 = 547: Exit Function
End Function

一致した場合は、処理を終えるようにしました。
この場合の実行時間は27秒となり半減しました。

さらに工夫します。

サンプル5 – If(場合分け＋終了)

Function test5(num)
    If num < 25 Then
        If num = 0 Then test5 = 404: Exit Function
        If num = 1 Then test5 = 194: Exit Function
        省略
    ElseIf num < 50 Then
        省略
    ElseIf num < 75 Then
        省略
    Else
        省略
        If num = 99 Then test5 = 547: Exit Function
    End If
End Function

例えば、80番目の値を拾うために79番目までをすべてチェックする必要はないわけです。
そこで100個を4分割して、0番目、25番目、50番目、75番目にジャンプするように場合分けしました。
この場合の実行時間は9秒となりました。効果絶大です。
なお、この場合分けを細かくし過ぎると逆効果ですし、プログラミングも面倒になりますので、使いどころを考える必要があるかもしれません。

サンプル 時間
配列変数 36秒
SelectCase 25秒
If(単純) 52秒
If(終了) 27秒
If(場合分け) 9秒

カテゴリー: マイクロソフト タグ:

フォルダ内のExcelファイルのモジュールをすべてエクスポート

2011 年 3 月 18 日 コメントはありません

ExcelのVBAのモジュールをエクスポートするにはVisual Basic エディタを開き、該当のモジュールを選択して右クリックし、エクスポートを選択します。
これは面倒だということで自動化するマクロが紹介されていました。ありがとうございます。

Excel VBAでモジュールをエクスポートするコード – paz3のおもいつき

これをお借りして、フォルダ内にあるExcelファイルをすべて開き、VBAモジュールをエクスポートする方法を考えてみました。
Excel2007で確認しました。

基本部分

次のコードを使用します。
ほとんどすべて元のコードのままです。
3個目の「ExportModuleWithExt」の一部を書き換えました。
元のコードではファイル名は「モジュール名＋拡張子」なのですが、複数のファイルをエクスポートするとダブル可能性があるのでファイル名を付加しています。

Public Sub ExportModules()
    '現在のワークブックのモジュールをエクスポートする
    Dim targetModule As VBComponent
    Dim outputPath As String
    Dim fileExt As String
    outputPath = ActiveWorkbook.Path
    For Each targetModule In ActiveWorkbook.VBProject.VBComponents
        fileExt = GetExtFromModuleType(targetModule.Type)
        If fileExt <> "" Then
            ExportModuleWithExt targetModule, outputPath, fileExt
            Debug.Print "Save " & targetModule.Name
        End If
    Next
End Sub

Private Function GetExtFromModuleType(aType As Integer) As String
    '指定されたモジュール・タイプに対応する拡張子を返す
    Select Case aType
    Case vbext_ct_StdModule
        GetExtFromModuleType = "bas"
    Case vbext_ct_ClassModule, vbext_ct_Document
        GetExtFromModuleType = "cls"
    Case vbext_ct_MSForm
        GetExtFromModuleType = "frm"
    End Select
End Function

Private Sub ExportModuleWithExt(aModule As VBComponent, Path As String, Ext As String)
    '指定されたモジュールをエクスポートする
    Dim filePath As String
    Dim fileName As String
    'filePath = Path & "\" & aModule.Name & "." & Ext
    fileName = ActiveWorkbook.Name
    filePath = Path & "\" & fileName & "-" & aModule.Name & "." & Ext
    aModule.Export filePath
End Sub

応用部分

複数のファイルに対して実行するための部分です。

Sub フォルダ内モジュール一括エクスポート()
    thisfn = ActiveWorkbook.Name
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "フォルダを選択"
        .AllowMultiSelect = False
        If .Show = -1 Then
            targetdir = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    targetfn = Dir(targetdir & "\", vbNormal)
    Do Until targetfn = ""
        If thisfn <> targetfn Then
            Call モジュールをエクスポート(thisfn, targetfn)
        End If
        targetfn = Dir
    Loop
    MsgBox "処理が終わりました。"
End Sub

Sub モジュールをエクスポート(thisfilename, targetfilename)
    Workbooks.Open fileName:=targetfilename
    Application.Run thisfilename & "!ExportModules"
    ActiveWorkbook.Close
End Sub

準備

適当なExcelファイルを新規作成します。
Visual Basic エディタを開き、上のコードをすべて貼り付けます。
ツール-参照設定を選択し、「Microsoft Visual Basic for Application Extensibility 5.3」にチェックを入れます。
Excelに戻り、Officeボタン-Excelのオプション-セキュリティセンター-セキュリティセンターの設定ボタンをクリックします。
マクロの設定を選択し、VBAプロジェクトオブジェクトモデルへのアクセスを信頼するにチェックを入れます。

使い方

モジュールをエクスポートしたいExcelファイルを一つのフォルダにコピーして集めます。
先ほど準備したExcelファイルに戻り、表示-マクロ-マクロの表示を選択します。
「フォルダ内モジュール一括エクスポート」を選択し実行します。
先ほど準備したフォルダを選択します。
次々にExcelが開かれてモジュールが同じフォルダにエクスポートされます。

カテゴリー: Excel タグ: ,

シート上のテキストボックスをすべて削除

2011 年 3 月 16 日 コメントはありません

Excelのシート上のテキストボックスをすべて削除する方法です。
Excel2007で確認しました。

通常の方法

  1. ホーム-編集-検索と選択-条件を選択してジャンプ-選択オプションダイアログを開く。(Ctrl+G、セル選択でも同じ)
  2. オブジェクトにチェックしてOKをクリック。
  3. テキストボックスがすべて選択されていることを確認。
  4. Deleteキーを押す。

これでテキストボックスがすべて削除されますが、テキストボックスだけでなく、その他の図形などもすべて削除されます。

マクロを使う方法

マクロを使う場合は次のようにします。

Sub shape_delete()
    For Each myshape In ActiveSheet.Shapes
        myshape.Delete
    Next
End Sub

この場合、やはりテキストボックスだけでなく他の図形も削除されてしまいます。
テキストボックスだけ削除する場合は次のようにします。
「.Type = msoTextBox」として図形がテキストボックスである場合だけ処理するようにします。

Sub textbox_delete()
    For Each myshape In ActiveSheet.Shapes
        If myshape.Type = msoTextBox Then
            myshape.Delete
        End If
    Next
End Sub

タイプを変えれば、例えば次のようにコメントだけを削除することもできます。

Sub comment_delete()
    For Each myshape In ActiveSheet.Shapes
        If myshape.Type = msoComment Then
            myshape.Delete
        End If
    Next
End Sub

例えば、ボタンなどのフォーム以外を指定したければ「.Type <> msoFormControl」とします。

カテゴリー: Excel タグ: ,

Googleカレンダー、インポート用CSVを作成するマクロ

2011 年 2 月 22 日 コメントはありません

Excelシートに作ったGoogleカレンダー用のデータをCSVに変換するマクロです。
出力されたCSVを使ってカレンダーにインポートすることができます。

Excelシート

Excelシートは次のように作ります。
日付と時刻はExcel形式(シリアル値)にします。

x A B C D E F
1 Subject Start Date Start Time End Date End Time Location
2 南アフリカ対メキシコ 2010/06/11 23:00 2010/06/12 01:00 ヨハネスブルク
3 ウルグアイ対フランス 2010/06/12 03:30 2010/06/12 05:30 ケープタウン
4 アルゼンチン対ナイジェリア 2010/06/12 23:00 2010/06/13 01:00 ヨハネスブルク

マクロ

アクティブシートに対して処理されます。
日付と時刻の行はFormat関数で整形されます。
カンマ付テキスト(UTF-8)に変換され、指定したファイル名で保存されます。

Sub Googleカレンダーインポート用CSV出力()
    fnsave = Application.GetSaveAsFilename( _
        "import.csv", "CSV(*.csv),*.csv")
    If fnsave = False Then Exit Sub
    mytext = ""
    i = 1
    Do
        j = 1
        Do
            If Right(Cells(1, j), 4) = "Date" Then
                temp = Format(Cells(i, j), "yyyy/mm/dd")
            ElseIf Right(Cells(1, j), 4) = "Time" Then
                temp = Format(Cells(i, j), "hh:mm")
            Else
                temp = Cells(i, j)
            End If
            mytext = mytext & temp & ","
            j = j + 1
        Loop Until Cells(i, j) = ""
        mytext = Left(mytext, Len(mytext) - 1) & vbCrLf
        i = i + 1
    Loop Until Cells(i, 1) = ""
    mytext = Left(mytext, Len(mytext) - Len(vbCrLf))
   
    With CreateObject("ADODB.Stream")
        .Type = 2
        .Charset = "utf-8"
        .Open
        .WriteText mytext, 1
        .SaveToFile fnsave, 2
        .Close
    End With
End Sub

実行結果

Subject,Start Date,Start Time,End Date,End Time,Location
南アフリカ対メキシコ,2010/06/11,23:00,2010/06/12,01:00,ヨハネスブルク
ウルグアイ対フランス,2010/06/12,03:30,2010/06/12,05:30,ケープタウン
アルゼンチン対ナイジェリア,2010/06/12,23:00,2010/06/13,01:00,ヨハネスブルク
カテゴリー: Excel タグ: , ,