特定フォルダ直下に含まれるxls,xlsxファイルのすべてのシートに対しすべてに同じ処理を行う【Excel VBA】

44行目から58行目は、任意の処理に置き換えれば流用可能。

'特定フォルダ直下に含まれるxls,xlsxファイルのすべてのシートに対しすべてに同じ処理を行う
Sub Excel_book_change()

Dim FolderName As String  '文字列を入れる変数として「FolderName」を使う
Dim index As Integer  '数字を入れる変数として「index」を使う
Dim FileName As String  '文字列を入れる変数として「FileName」を使う
Dim i As Integer


Application.ScreenUpdating = False

    'FileDialogオブジェクトのインスタンス取得：フォルダ選択ダイログ
    With Application.FileDialog(msoFileDialogFolderPicker)
         
        
        .Title = "フォルダを選択してください"  'ダイアログのタイトルを設定             
        .InitialFileName = ThisWorkbook.Path 'ダイアログの初期パスを設定

        If Not .Show Then Exit Sub             'ダイアログを表示（キャンセル：処理抜け）
         
        FolderName = .SelectedItems(1)        '選択したフォルダのフルパスを変数格納

         
    End With
    
    
'実行可否判定
If MsgBox("選択されたフォルダは、" & FolderName & "です。　実行しますか？", vbDefaultButton2 + vbYesNo) = vbNo Then
    MsgBox ("処理を終了します。")
    Application.ScreenUpdating = True
    Exit Sub
End If


'選択されたフォルダ直下のるxls,xlsxファイルのすべてのシートに対しすべてに同じ処理を行う
FileName = Dir(FolderName & "\*xls*")  ' フォルダの中に含まれるファイルを取り出す
Do While FileName <> ""  ' ファイルがなくなるまで繰り返す
  Workbooks.Open FolderName & "\" & FileName 'ファイルを開く
        
        
        
     ' ForからNextまでに処理を記載
     For i = 1 To Worksheets.Count

        '全シートA1選択
        Worksheets(i).Activate
        Worksheets(i).Cells(1, 1).Select

        '印刷設定
        With Worksheets(i)
    
            .PageSetup.Orientation = xlLandscape '印刷の向きを「横」
            .PageSetup.PaperSize = xlPaperA4     '指定する用紙A4
            .PageSetup.CenterFooter = "-　" & "&P" & "　-"  'フッターにページ番号を表示
            .PageSetup.RightHeader = "&F" '右ヘッダー：現在の日付・時刻
    
        End With


    Next
        
        Worksheets(1).Activate
        Workbooks(Workbooks.Count).Save
        Workbooks(Workbooks.Count).Close
        
        
        FileName = Dir() '
Loop

 
 Application.ScreenUpdating = True
 
 
End Sub

test

表構造が同じ複数シートを1つのシートに統合する【Excel VBA】

Sub sheet_merge()

  Dim i As Integer
  Dim lRow As Long, lCol As Long, lRow2 As Long
  Dim newSh As String
  Dim Sh As Worksheet, myFlag As Boolean
    
    
    Application.ScreenUpdating = False
    
    
    newSh = "全データ"  'まとめ用のシート名です
    myFlag = False  'まとめ用のシートが有ったら True /無かったら False にするフラッグです
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.Name = newSh Then
            myFlag = True
            '-全データシートのデータをクリアし、先頭へ移動します
            Worksheets(newSh).Cells.ClearContents
            Worksheets(newSh).Move before:=Sheets(1)
            Exit For
        End If
    Next Sh
    
    '-全データシートを先頭へ追加します
    If myFlag = False Then
        ActiveWorkbook.Worksheets.Add(before:=Worksheets(1)).Name = newSh
    End If
    
    

    
    '-列見出しをコピーします(下記は1行目の場合、1～5行目がヘッダの場合は「Range("1:5")」のようにする)
    Worksheets(2).Range("1:1").Copy Worksheets(1).Range("A1")
    rast_row2 = Worksheets(1).Cells(100000, 2).End(xlUp).Row + 1
    
    For i = 2 To Worksheets.Count
        With Worksheets(i)
            
       
        rast_row = Worksheets(i).Cells(100000, 2).End(xlUp).Row
        Worksheets(i).Activate
        Range(Cells(2, 1), Cells(rast_row, 16384)).Copy Worksheets(1).Cells(rast_row2, 1) ' 最初の　Cells(2, 1)はヘッダ行に合わせて修正する ヘッダが5行目まである時は、Cells(6, 1)にする。
        rast_row2 = Worksheets(1).Cells(100000, 2).End(xlUp).Row + 1
            
        End With
    
    Next i
    
    Worksheets(1).Activate
    Range("A1").Select
    Application.ScreenUpdating = True


End Sub

グループ毎に見やすい様に罫線を引く【Excel VBA】

実行イメージ

＃使い方とかがかっこ悪いので時間はがある時に見直す予定。

Sub group_out_line()

' 使い方　ヘッダを除く表範囲(表範囲は最下行＋1行)を選択してこのマクロを動かす。

    '表の対象範囲を取得する
    t = Selection.Address
    t = Replace(t, "$", "")
    startcell = InStr(t, ":")
    s = Left(t, (startcell - 1))
    s = "$" & s
    e = Mid(t, (startcell + 1), 10000)
    
    n = ActiveCell.Offset(-1, 0).Address
    n = Replace(n, "$", "")
    n = "$" & n
    
    
    '最左列のカラムの文字列が1行上と同じでない場合は、実線となる。
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=" & n & "<>" & s

    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Selection.FormatConditions(1).StopIfTrue = False

    With Selection.FormatConditions(1).Borders(xlLeft)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    With Selection.FormatConditions(1).Borders(xlRight)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With




    '最左列のカラムの文字列が1行上と同じの場合は、点線となる｡
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=AND(" & s & "=" & n & "," & s & "<>" & """"")"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlDot
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    With Selection.FormatConditions(1).Borders(xlLeft)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    With Selection.FormatConditions(1).Borders(xlRight)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
    
    Selection.FormatConditions(1).StopIfTrue = False
    
    
    '最左列のカラムの文字列が1行上と同じの場合は、点線となる｡
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=" & s & "="""""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Borders(xlTop)
        .LineStyle = xlContinuous
        .TintAndShade = 0
        .Weight = xlThin
    End With
        
    With Selection.FormatConditions(1).Borders(xlLeft)
        .LineStyle = xlLineStyleNone
    End With
    
    With Selection.FormatConditions(1).Borders(xlRight)
        .LineStyle = xlLineStyleNone
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    
    

End Sub

選択したセル中に含まれる文字列のフォント変更【Excel VBA】

実行イメージ(市を赤太文字に変更。)

Sub font_color_change(a_sSearch, a_lColor, a_bBold)
    Dim f   As Font     'Fontオブジェクト
    Dim i               '引数文字列のセルの位置
    Dim iLen            '引数文字列の文字数
    Dim r   As Range    'セル範囲の１セル
    
    iLen = Len(a_sSearch)
    i = 1
    
    '選択セル範囲を１セルずつループ
    For Each r In Selection
        '指定されたセルの文字列から引数文字列を全て検索
        Do
            'セル文字列から引数文字列を検索
            i = InStr(i, r.Value, a_sSearch)
            
            '引数文字列が存在しない場合
            If (i = 0) Then
                '次検索用に検索開始位置を1に初期化
                i = 1
                
                'このセルの処理を終了
                Exit Do
            End If
            
            '引数文字列部分のFontオブジェクトを取得
            Set f = r.Characters(i, iLen).Font
            
            'フォント設定
            f.Color = a_lColor  '文字色
            f.Bold = a_bBold    '太さ
            
            '次検索用に検索開始位置をずらす
            i = i + 1
        Loop
    Next
End Sub







'実際に使う時に呼び出すプロシージャ
Sub font_color_change_exe()
    '使い方 [Call font_color_change("フォント変更対象文字列", 変更後の色（RGB指定), 太字有無]
    '複数の文字を対象にしたい場合は、行追加して増やしていく
    Call font_color_change("フォント変更対象文字列", RGB(255, 0, 0), True)
    
    MsgBox ("処理完了しました")
   
End Sub

Powershell系のコマンド

■OS起動とOS停止の時間を知らべる 12が起動で13が停止のID

$events = Get-EventLog System
$events | ? { ($_.InstanceID -eq "12") -or ($_.InstanceID -eq "13") } | Out-GridView

■テキストファイルをtailしてgrep

Get-Content [対象ファイルのフルパス] -wait | Select-String "[grepする文字列]"

■PowerShellのVersionを表示

$PSVersionTable

■適用済みのパッチを表示

Get-HotFix | where { $_.InstalledOn -ne $null } | Out-GridView

■通信ポートとプロセスの状況を確認する

netstat -ano

↓実行ファイル名が知りたい場合
netstat -anobv