tkhrsskの日記

技術ネタなど

開いているブック一覧 ＆ ワイルドカード判定

EXCEL VBA

標題の通り。

Sub ブック一覧()
    Dim wb As Workbook
    Dim sheet As Worksheet
    
    Debug.Print "ThisBook :" & ThisWorkbook.Name
    
    For Each wb In Workbooks
        Debug.Print wb.Name
        If wb.Name Like "*探し物*" Then
            Debug.Print "探し物が見つかりました！ :" & wb.Name
        End If
        For Each sheet In wb.Worksheets
            Debug.Print "  Sheet: " & sheet.Name
        Next sheet
    Next wb
End Sub

オートフィルタ状態の確認

EXCEL VBA

またも深夜のVBA探索。。。

フィルタ状況を調べる

Sub フィルタチェック()
    Dim i As Long, title As String
    Dim f As Filter
    Dim af As AutoFilter

    If ActiveSheet.AutoFilterMode Then
        For i = 1 To ActiveSheet.AutoFilter.Filters.Count
            Set f = ActiveSheet.AutoFilter.Filters(i)
            With f
                If f.On Then
                    title = ActiveSheet.AutoFilter.Range.Cells(1, i)
                    Debug.Print f.Operator
                    Select Case f.Operator
                    Case 0
                        Debug.Print title & f.Criteria1 & " で絞り込まれています"
                    Case xlAnd
                        Debug.Print title & f.Criteria1 & " and " & title & f.Criteria2 & " で絞り込まれています"
                    Case xlOr
                        Debug.Print title & f.Criteria1 & " or " & title & f.Criteria2 & " で絞り込まれています"
                    Case xlFilterValues
                        Dim j As Long
                        For j = LBound(f.Criteria1) To UBound(f.Criteria1)
                            Debug.Print title & f.Criteria1(j) & " で絞り込まれています"
                        Next j
                    Case Else
                    End Select
                End If
            End With
        Next i
        Debug.Print "レコード数：" & ActiveSheet.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
    End If
End Sub

フィルタをかける

    ActiveSheet.AutoFilter.Range.AutoFilter Field:=3, Criteria1:="=00001", _
        Operator:=xlOr, Criteria2:="=00002"

VBAでWorkbook Close時に強制停止の回避方法

EXCEL VBA

環境依存だったが、EXCEL VBAマクロで強制停止する現象が発生した。

ステップ実行していったところ、Workbook Close時に死んでいるっぽい。

いろいろと検証してみたところ、大きな領域をコピーしたままEXCELを閉じるときにでる
"あの警告"がでる場合に問題らしい。

ということで、Closeするまえに、コピー状態を解除することで回避実現。

Application.CutCopyMode = False

以上

複数ブックを集約して加工

EXCEL VBA

EXCELと格闘する日々に効率化を。。

職場に役立ちそうな EXCEL VBA を深夜自宅で勉強中。。。眠い。

なんだか20年くらい前の仕事をしている気分。

Visual Basic for Applications - Wikipedia

f:id:tkhrssk:20150813034953p:plain

Sub OpenBookSheet(ByVal FilePath As String, ByVal Sheet As String, ByVal NewSheet As String)
    Const xKey_Col = 1 'キー列番号
    Const xHeads = 1 '見出しの行数
    
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim TargetBook As Workbook
    Set TargetBook = Workbooks.Open(Filename:=FilePath)
    ThisWorkbook.Activate
    
    ' アクティブシートを記憶
    Dim OldSheet As Worksheet
    Set OldSheet = ActiveSheet
    
    ' 新シートを作成
    Dim NewWorkSheet As Worksheet
    ThisWorkbook.Worksheets(NewSheet).Delete
    Set NewWorkSheet = Worksheets.Add()
    NewWorkSheet.Name = NewSheet
    
    With TargetBook.Sheets(Sheet)
        xLast = .Cells(Rows.Count, xKey_Col).End(xlUp).Row
        Application.CutCopyMode = False
        .UsedRange.Copy
        NewWorkSheet.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
    End With
        
    TargetBook.Close
    
    OldSheet.Activate
    
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Sub DeleteRow(ByVal Sheet As String, ByVal StartTarget As String, ByVal EndTarget As String)
    '行削除
    ThisWorkbook.Worksheets(Sheet).Range(StartTarget & ":" & EndTarget).Delete
End Sub

Sub 集計開始()

    ' ブックと同一のパスからファイルを検索
    Dim buf As String, cnt As Long
    Dim Col As Long
    Dim Path As String
    Dim File As String
    Dim Sheet As String
    Dim NewSheet As String
    Dim PathFile As String
    Dim Target As String
    
    Path = ThisWorkbook.Path

    For cnt = 0 To 5
        File = Cells(cnt + 6, 2)
        Sheet = Cells(cnt + 6, 3)
        NewSheet = Cells(cnt + 6, 4)
        If File = "" Then Exit For
        If Sheet = "" Then Exit For
        If NewSheet = "" Then Exit For
        
        ' ファイル名 記録
        PathFile = Path & "\\" & File
        buf = Dir(PathFile)
        Cells(cnt + 6, 6) = buf
        
        ' シートのコピー
        OpenBookSheet Path & "\\" & buf, Sheet, NewSheet
        
        ' 範囲削除
        For Col = 0 To 10 Step 2
            StartTarget = Cells(cnt + 6, Col + 7)
            EndTarget = Cells(cnt + 6, Col + 8)
            If StartTarget <> "" And EndTarget <> "" Then
                DeleteRow NewSheet, StartTarget, EndTarget
            End If
        Next Col
        
    Next cnt

End Sub

Cmder (ConEmuベース) のカスタマイズ

開発環境

Windowsのコンソールエミュレータ「Cmder」のカスタマイズについてメモ。 なお、Cmder自体は、Chocolateyでいれました。

日本語対応

  • フォントの下のオプションの、"Monoscape"のチェックを外します。

qiita.com

プロンプト

標準で、ラムダ(λ)がプロンプトになっています。 どうもマルチバイトのせいか、たまに悪さをしていました。

C:\tools\cmder\vendor\init.bat を開き、プロンプトの指定を変更。 ※{lamb}を$G(不等号>)にします。

@prompt $E[1;32;40m$P$S{git}$S$_$E[1;30;40m$G$S$E[0m

alias

C:\tools\cmder\config\aliasesを編集。 gstの追加とlsの日本語表示対策--show-control

gst=git status $*
ls=ls --show-control --color $*

ショートカット

Win+r, cmdでコマンドプロンプトを開くのになれているので、 Cmderもパスを通しておきます。また、em というショートカットを作っておき、 開く労力を最小限にします。

参考になりそうなリンク

mycoredump.hatenablog.com

cm3.hateblo.jp

chcp 65001 したほうがいいのかな。。