MW211 EXIT

devlog
ExcelVBA/特定文字以降を除去
2023年02月24日
例えば「(」以降を除去する方法。いくつかある。
┌──────────┬───────────────────────────┐
│正規表現を用いる方法│Dim REG As Object                                     │
│                    │Set REG = CreateObject("VBScript.RegExp")             │
│                    │REG.Global = True                                     │
│                    │REG.Pattern = "\(.*$"                                 │
│                    │文字列 = REG.Replace(文字列, "")                      │
├──────────┼───────────────────────────┤
│文字位置を調べる方法│Dim 位置 As Long                                      │
│                    │位置 = InStr(1, 文字列, "(", vbTextCompare)           │
│                    │If (位置 > 0) Then                                    │
│                    │    文字列 = Left(文字列, 位置 - 1)                   │
│                    │End If                                                │
├──────────┼───────────────────────────┤
│配列を用いる方法    │文字列 = Split(文字列, "(")(1)                        │
└──────────┴───────────────────────────┘
分類:ExcelVBA
ExcelVBA/図形の削除
2022年09月27日
┌──────────────────────────────────────┐
│シート.Label除去対象.Delete                                                 │
└──────────────────────────────────────┘
図形(例えばLabel)を削除したい場合に上記のように自ら削除すると
「プロシージャの呼び出し、または引数が不正です」エラーが発生する場合
以下のように、図形をループする形で削除すれば、エラーがでないようだ。
┌──────────────────────────────────────┐
│Dim 図形 As Object                                                          │
│For Each 図形 In シート.OLEObjects                                          │
│    If 図形.Name = "Label除去対象" Then                                     │
│        図形.Delete                                                         │
│    End If                                                                  │
│Next 図形                                                                   │
└──────────────────────────────────────┘
分類:ExcelVBA
ExcelVBA/フォルダ作成
2022年07月06日
┌──────────────────────────────────────┐
│'===========================================================================│
│'  フォルダ作成                                                             │
│'===========================================================================│
│Private Sub フォルダ作成(ByVal パス As String)                              │
│    Dim objFSO As Object                                                    │
│    Set objFSO = CreateObject("Scripting.FileSystemObject")                 │
│    '-----------------------------------------------------------------------│
│    '  既に存在するか?                                                     │
│    '-----------------------------------------------------------------------│
│''''If Dir(パス, vbDirectory) <> "" Then                                    │
│    If objFSO.FolderExists(パス) Then                                       │
│        MsgBox "そのフォルダは既に存在します"                               │
│        Exit Sub                                                            │
│    End If                                                                  │
│    '-----------------------------------------------------------------------│
│    '  親フォルダは存在するか?                                             │
│    '-----------------------------------------------------------------------│
│    Dim objREG As Object                                                    │
│    Set objREG = CreateObject("VBScript.RegExp")                            │
│    Dim 親パス As String                                                    │
│    objREG.Pattern = "\\[^\\]*$"                                            │
│    親パス = objREG.Replace(パス, "")                                       │
│''''If Dir(親パス, vbDirectory) = "" Then                                   │
│    If Not objFSO.FolderExists(親パス) Then                                 │
│        MsgBox "パスが不正です(親フォルダが見当たりません)" & vbCrLf _      │
│             & 親パス                                                       │
│        Exit Sub                                                            │
│    End If                                                                  │
│    '-----------------------------------------------------------------------│
│    '  フォルダ作成                                                         │
│    '-----------------------------------------------------------------------│
│''''MkDir パス                                                              │
│    Call objFSO.CreateFolder(パス)                                          │
│    MsgBox "終了"                                                           │
│End Sub                                                                     │
│'===========================================================================│
└──────────────────────────────────────┘
分類:ExcelVBA
ExcelVBA/シートのグループごと集計
2022年01月20日
A列とB列が複合キーでC列の値を集計したい場合のマクロ。
┌──────────────────────────────────────┐
│Option Explicit                                                             │
├──────────────────────────────────────┤
│Public Sub 集計()                                                           │
│    Application.ScreenUpdating = False                                      │
│    Dim yMax As Long, y As Long, yKey As Long                               │
│    With ThisWorkbook.Worksheets("対象名")                                  │
│        Call ソート                                                         │
│        yMax = .UsedRange.Rows(.UsedRange.Rows.Count).Row                   │
│        y = 1                                                               │
│        Do While y <= yMax                                                  │
│            yKey = y                                                        │
│            Do                                                              │
│                If y <> yKey Then                                           │
│                    .Cells(yKey, 3).Value = .Cells(yKey, 3).Value _         │
│                                          + .Cells(y, 3).Value              │
│                    .Rows(y).ClearContents                                  │
│                End If                                                      │
│                y = y + 1                                                   │
│            Loop While y <= .Rows.Count _                                   │
│                And .Cells(y, 1).Value = .Cells(yKey, 1).Value _            │
│                And .Cells(y, 2).Value = .Cells(yKey, 2).Value              │
│        Loop                                                                │
│        Call ソート                                                         │
│    End With                                                                │
│    Application.ScreenUpdating = True                                       │
│End Sub                                                                     │
├──────────────────────────────────────┤
│Private Sub ソート()                                                        │
│    With ThisWorkbook.Worksheets("対象名")                                  │
│        With .Sort                                                          │
│            With .SortFields                                                │
│                .Clear                                                      │
│                .Add Key:=ThisWorkbook.Worksheets("対象名").Columns(1), _   │
│                     SortOn:=xlSortOnValues, _                              │
│                     Order:=xlAscending, _                                  │
│                     DataOption:=xlSortNormal                               │
│                .Add Key:=ThisWorkbook.Worksheets("対象名").Columns(2), _   │
│                     SortOn:=xlSortOnValues, _                              │
│                     Order:=xlAscending, _                                  │
│                     DataOption:=xlSortNormal                               │
│            End With                                                        │
│            .SetRange ThisWorkbook.Worksheets("対象名").Cells               │
│            .Header = xlYes                                                 │
│            .MatchCase = True                                               │
│            .Orientation = xlTopToBottom                                    │
│            .SortMethod = xlPinYin                                          │
│            .Apply                                                          │
│        End With                                                            │
│    End With                                                                │
│End Sub                                                                     │
└──────────────────────────────────────┘
分類:ExcelVBA
ExcelVBA/図形をヘッダに
2021年10月24日
印刷範囲の大きさに応じて、印刷倍率を変更する設定とした場合
当然だが、シート上の図形もその影響を受けて縮小される。

これを避けるために、ヘッダ(もしくはフッタ)に置いて
拡大縮小の影響を受けないようにしたらよいのではないか?

と考えてが、ヘッダに単なる画像ファイルを出力するのは簡単でも
図形を出力するのは難儀を極める。

まず、そのままでは無理なようだ。

ということで、図形を画像ファイルとして一旦エクスポートして
それを参照する形で対処してみた。(画像ファイルの削除はご自分で)

なお、図形を画像ファイルとして出力するにもそのままでは無理で
チャートを作成し、そこに貼り付けて、出力する形をとらざろうえないようだ。
┌──────────────────────────────────────┐
│Dim 図形 As Shape, チャート As Object                                       │
│With ActiveSheet                                                            │
│    '-----------------------------------------------------------------------│
│    '  図形を画像ファイルとしてエクスポート                                 │
│    '-----------------------------------------------------------------------│
│    Set 図形 = .Shapes(図形名)                                              │
│    Set チャート = .ChartObjects.Add(0, 0, 図形.Width, 図形.Height)         │
│    図形.CopyPicture Format:=xlBitmap                                       │
│    With チャート                                                           │
│        .Select                                                             │
│        .Chart.Paste                                                        │
│        .Chart.Export Filename:=ThisWorkbook.Path & "\一時.jpg"             │
│        .Delete                                                             │
│    End With                                                                │
│    '-----------------------------------------------------------------------│
│    '  エクスポートした画像ファイルをヘッダに                               │
│    '-----------------------------------------------------------------------│
│    With .PageSetup                                                         │
│        .LeftHeaderPicture.Filename = ThisWorkbook.Path + "\一時.jpg"       │
│        Application.PrintCommunication = False  ' プリンタ設定開始(通信切断)│
│        ' 上余白                                                            │
│        .TopMargin = 図形.Height                                            │
│        ' 「&[図]」を表示                                                   │
│        .LeftHeader = "&G"                                                  │
│        ' 「ドキュメントに合わせて拡大/縮小」しない                         │
│        .ScaleWithDocHeaderFooter = False                                   │
│        Application.PrintCommunication = True   ' プリンタ設定終了(通信復旧)│
│    End With                                                                │
│    '-----------------------------------------------------------------------│
│End With                                                                    │
└──────────────────────────────────────┘
つまり、以下の課題を解決しないと実現できないという結構な難題だ。
(1) ヘッダに図形を出力したい
(2) そのためには、図形を画像ファイルにする必要がある
(3) そのためには、図形をチャートに貼り付ける必要がある
分類:ExcelVBA
ExcelVBA/ファイル・フォルダ選択
2021年10月05日
いろいろ方法があるのでまとめていきたいが、ひとまず一例。

【ファイル選択】
┌──────────────────────────────────────┐
│Dim ファイルパス As String                                                  │
│' 本ファイルのフォルダを既定に                                              │
│ChDir ThisWorkbook.Path                                                     │
│If Left(ThisWorkbook.Path, 1) <> Left(CurDir, 1) Then                       │
│    ChDrive Left(ThisWorkbook.Path, 1)                                      │
│End If                                                                      │
│' 選択ダイアログ表示                                                        │
│ファイルパス = Application.GetOpenFilename( _                               │
│    Title:="ファイルを選択してください。", _                                │
│    Filefilter:="Excelファイル,*.xlsm" _                                    │
│)                                                                           │
│If ファイルパス = "False" Then                                              │
│    MsgBox "キャンセル"                                                     │
│End If                                                                      │
└──────────────────────────────────────┘

【フォルダ選択】
┌──────────────────────────────────────┐
│Dim フォルダパス As String                                                  │
│With Application.FileDialog(msoFileDialogFolderPicker)                      │
│    .Title = "フォルダを選択してください。"                                 │
│    .InitialFileName = ThisWorkbook.Path & "\"                              │
│    If .Show Then                                                           │
│        フォルダパス = .SelectedItems(1)                                    │
│    End If                                                                  │
│End With                                                                    │
└──────────────────────────────────────┘
分類:ExcelVBA
複合キーでVLOOKUP(連想配列版)
2021年10月04日
一旦、連想配列にデータをぶちこんで、それで直接アクセスするやり方。
キーをタブ結合(タブじゃなくてもいいけど)で、一つにするのがポイント。
┌──────────────────────────────────────┐
│Dim yMax As Long, y As Long, 連想配列 As Object, キー As String             │
│Set 連想配列 = CreateObject("Scripting.Dictionary")                         │
├──────────────────────────────────────┤
│' 連想配列に格納                                                            │
│With 参照シート                                                             │
│    yMax = .UsedRange.Rows(.UsedRange.Rows.Count).Row                       │
│    For y = 2 To yMax                                                       │
│        キー = .Cells(y, Xキー1).Value & vbTab & .Cells(y, Xキー2).Value    │
│        If Not 連想配列.Exists(キー) Then                                   │
│            連想配列.Add キー, .Cells(y, Xバリュー).Value                   │
│        End If                                                              │
│    Next y                                                                  │
│End With                                                                    │
├──────────────────────────────────────┤
│' 連想配列を検索                                                            │
│キー = キー1 & vbTab & キー2                                                │
│If 連想配列.Exists(キー) Then                                               │
│    MsgBox 連想配列(キー)                                                   │
│End If                                                                      │
└──────────────────────────────────────┘
結構速いし、小難しい処理(該当なしで例外とか)がないのでいいかも。
分類:ExcelVBA
ExcelVBA/図形内の改行
2021年08月27日
図形内Textの改行は「vbCrLf」で入力しても「vbCr」になる模様。
「vbLf」かと思った違った。
なお、正規表現は「\r」で代用できる。
分類:ExcelVBA
ExcelVBA/フォルダ移動
2021年06月03日
┌──────────────────────────────────────┐
│ChDir ThisWorkbook.Path                                                     │
└──────────────────────────────────────┘
上記でフォルダ移動ができない場合…

それは、Dドライブとかにそのファイルがある場合で
ドライブ移動も一緒にしないといけないというかもしれない。

ひとまず以下で回避できる。(Dドライブなら)
┌──────────────────────────────────────┐
│ChDir ThisWorkbook.Path                                                     │
│If Left(ThisWorkbook.Path, 1) = "D" Then                                    │
│    ChDrive Left(ThisWorkbook.Path, 1)                                      │
│End If                                                                      │
└──────────────────────────────────────┘

さて、Eドライブやネットワークドライブ(\\)の時はどうしよう?
分類:ExcelVBA
ExcelVBA/多次元連想配列
2021年04月07日
┌──────────────────────────────────────┐
│Dim ハッシュ As Object                                                      │
│Dim i As Long, キー As Variant                                              │
│Set ハッシュ = CreateObject("Scripting.Dictionary")                         │
│ハッシュ.RemoveAll  ' 参考(全削除)                                          │
│' 値設定                                                                    │
│Set ハッシュ(ハッシュ.Count) = CreateObject("Scripting.Dictionary")         │
│ハッシュ(ハッシュ.Count - 1)("名前") = "織田信長"                           │
│ハッシュ(ハッシュ.Count - 1)("住所") = "安土城"                             │
│Set ハッシュ(ハッシュ.Count) = CreateObject("Scripting.Dictionary")         │
│ハッシュ(ハッシュ.Count - 1)("名前") = "豊臣秀吉"                           │
│ハッシュ(ハッシュ.Count - 1)("住所") = "大阪城"                             │
│Set ハッシュ(ハッシュ.Count) = CreateObject("Scripting.Dictionary")         │
│ハッシュ(ハッシュ.Count - 1)("名前") = "徳川家康"                           │
│ハッシュ(ハッシュ.Count - 1)("住所") = "江戸城"                             │
├──────────────────────────────────────┤
│' 値参照(方法1)                                                             │
│For i = 0 To ハッシュ.Count - 1                                             │
│    MsgBox ハッシュ(i)("名前") & " in " & ハッシュ(i)("住所")               │
│Next i                                                                      │
│' 値参照(方法2)                                                             │
│For Each キー In ハッシュ                                                   │
│    MsgBox ハッシュ(キー)("名前") & " in " & ハッシュ(キー)("住所")         │
│Next キー                                                                   │
└──────────────────────────────────────┘
分類:ExcelVBA
前へ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 … 27 次へ