Boolean Effect

VBA よく使うコードまとめ

ExcelのVBAのよく使うコードをまとめてみました。広く浅くプログラムしていると、久しぶりにマクロを使ってみるとFor文も書けなくなることがあり。とりあえずまとめてみました。

以下の表をSheet1のA1からコピペしてください

次のコードをマクロに記述してください

VBAお品書き

• 範囲選択
• 2条件並べ替え
• 空セルOkの最下のセル取得、空セルOkの最も右のセル取得
• 範囲からの検索
• シートを別のブックに保存（マクロをはずす）

'==範囲の選択の書き方　コピー==================
Sub RangeCopy()
    With Worksheets("Sheet1")
        .Range(.Cells(1, 1), .Cells(10, 4)).Copy
    End With
    ThisWorkbook.Worksheets("Sheet1").Cells(1, 5).PasteSpecial Paste:=xlValue
End Sub
'＝＝2条件並び替え＝2003バージョン＝＝＝＝＝＝＝
Sub fill()
    Application.ScreenUpdating = False 'ちらつき防止
    With ThisWorkbook.Worksheets("Sheet1")
        .Range(.Columns(1), .Columns(3)).Sort _
        Key1:=.Range("A1"), Order1:=xlAscending, _
        Key2:=.Range("B1"), Order2:=xlAscending, _
        Header:=xlYes, MatchCase:=False, Orientation:=xlTopToBottom
    End With
    Application.ScreenUpdating = True
    
End Sub
'＝＝最下のRow,最右のColumn (空白OK)＝＝＝＝
Sub GetRowCol()
Dim maxrow As Integer
Dim maxcol As Integer
    With ThisWorkbook.Worksheets("Sheet1").UsedRange
            maxrow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
            maxcol = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
    End With
    
    MsgBox ("最下の行は　" & maxrow & "　です" & vbCrLf & "最も右の列は　" & maxcol & "　です")
End Sub
'==　おまけ==================
Sub CleanUp()
    With Worksheets("Sheet1")
        .Range(.Cells(1, 5), .Cells(10, 8)).Copy
    End With
    ThisWorkbook.Worksheets("Sheet1").Cells(1, 1).PasteSpecial Paste:=xlValue
    
    With Worksheets("Sheet1")
        .Range(.Cells(1, 5), .Cells(10, 8)).ClearContents
    End With
    
End Sub
'＝＝検索＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
Sub serch()
Dim searchResult As Range
    myf = ThisWorkbook.Worksheets("Sheet1").Cells(2, 4).Value
  
    With Worksheets("Sheet1")
        Set searchResult = .Range("A1:C10").Find(myf, LookIn:=xlValues, LookAt:=xlWhole)
    End With
   
    If searchResult Is Nothing Then
        '検索でなければ
    Else
        MsgBox ("合致あり")
    End If
End Sub
'＝＝アクティブsheetを名前を付けて保存＝＝＝＝
Sub SheetSave()
Dim path As String
path = ThisWorkbook.path
Dim fname As String
fname = "name"
    Application.DisplayAlerts = False 'アラート　OFF
    fname = path & "\" & fname & ".xls"
    ThisWorkbook.ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=fname
    ActiveWorkbook.Close
    
    Application.DisplayAlerts = True
End Sub