vba たまにしか使わなくて忘れちゃうので、忘備録。

2019/08/17

vba たまにしか使わなくて忘れちゃうので、忘備録。

■置換(時間が掛からないように行を指定してからの場合)
例)H I J の列の中の「AAA」を「BBB」に置換する。セルの中身を丸ごと置換する。(これは、一部の置換は出来ない)
Range("H:J").Select
Selection.Replace What:="AAA", Replacement:="BBB"

■最終行や最終列の取得(途中に空白行があっても最終部分を認識する)
※基本的に、この取得方法が理想だが、セルに入力された部分を最終と判断させるか、セルに入力されていなくても、そこに罫線や色が設定されていれば、最終と判断させるかで、使い分ける
=================================
セルの色とか罫線も認識させる場合
=================================
Dim maxrow, maxcol
With ActiveSheet.UsedRange
maxrow = .Rows(.Rows.Count).Row
maxcol = .Columns(.Columns.Count).Column
End With

=================================
値のみで空白セルの書式ありは含まない場合
=================================
Dim MaxRow, MaxCol As Long
With ActiveSheet.UsedRange
MaxRow = .Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
MaxCol = .Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column
End With

■最終行まで繰り返し処理する
For i = 1 To maxrow
処理内容
Next i

■配列の宣言
1~3を用意する場合
例1)Dim i(1 To 3) As Variant
例2)
Dim i() As Variant
ReDim mi(3)

■配列の取得
例)C9から下に続く情報を、mise()という配列に格納する
ReDim mise(maxrow)
For i = 1 To maxrow
mise(i) = Cells(8 + i, 3).Value
Next i

■Cellsの縦横軸
Cells(3,5)の意味は、Cells(縦, 横)3が縦、5が横だから、C5のこと。
これ、いっつも逆に書いてしまう。。。

■ブックを開く
例)Workbooks.Open "\\192.168......\ファイル名.xls"

■ブックを保存せずに閉じる
Application.DisplayAlerts = False
Workbooks("ファイル名.xlsx").Close
Application.DisplayAlerts = True

■列の選択・列選択
C列の選択)Columns(3).Select
C~E列の選択)Range(Columns(3), Columns(5)).Select
C列の選択)Columns("C").Select
C~E列の選択)Columns("C:E").Select

■行の選択・行選択
3行目選択)Rows(3).Select
3~5行目の選択)Rows("3:5").Select

■1行目から、最終行まで選択(変数で指定したい場合)
Dim maxrow
With ActiveSheet.UsedRange
maxrow = .Rows(.Rows.Count).Row
End With
Range(Rows(1), Rows(maxrow)).Select

■1行目に色を設定
Rows(1).Interior.ColorIndex = 6' 背景色
Rows(1).Font.ColorIndex = 3 ' 文字色
インデックスカラー

■日付時間を保存時に自動書き込み(ThisWorkbookにコード記述)
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ActiveSheet.Range("A1").Value = Now '特定シートなら Worksheets(1)
End Sub

■ハイなら実行、ちがうなら停止のマクロ
Dim i
i = MsgBox("ハイなら実行、ちがうなら停止のマクロ", vbYesNo)
If i = vbNo Then
Exit Sub
Else
End If

■選択セルの行を取得
i = ActiveCell.Row

■A列に関数を設定して下にコピー(オートフィル)する
Dim xxx As Integer
xxx = Range("A1").End(xlDown).Row
Range(ActiveSheet.Cells(2,1), ActiveSheet.Cells(xxx, 1)).Select
Selection.FillDown

■空白になるまで処理をする
Do
●●●ここに処理を入れる
ActiveCell.Offset(1, 0).Select 'これは処理を次の行に移すためのコード
Loop Until ActiveCell.Value = ""

■A列を文字列にする
Columns("A:A).NumberFormatLocal = "@"

■並び替えに失敗しな用にA列のフリガナを削除する
Range("A:A").Characters.PhoneticCharacters = ""

■■AQ列で、シート分け
Dim Sh As Worksheet
Dim MyR As Range, aaa As Range
Dim HedV As Variant
Set Sh = ActiveSheet
HedV = Rows(1).Value
'Application.ScreenUpdating = False
'C1で並び替えがきれいにいくようにふりがなフリガナを削除する
Range("AQ:AQ").Characters.PhoneticCharacters = ""
'C1で並び替え
'Range("A1").CurrentRegion.Sort Key1:=Range("AQ1"), _
'Order1:=xlAscending, Header:=xlYes, Orientation:=xlSortColumns
Range("A1").Subtotal 43, xlCount, Array(42)
Set MyR = Range("A2", Range("A65536").End(xlUp)).SpecialCells(2)
For Each aaa In MyR.Areas
With Worksheets.Add(After:=Worksheets(Worksheets.Count))
.Rows(1).Value = HedV
aaa.EntireRow.Copy
.Range("A2").PasteSpecial xlPasteAll
.Range("A1").Select
.Name = aaa.Range("AQ1").Value
Selection.ClearOutline
End With
Application.CutCopyMode = False
Next
Sh.Activate: Sh.Cells.RemoveSubtotal
'Application.ScreenUpdating = True
'オブジェクトのセット解放
Set MyR = Nothing: Set Sh = Nothing
End Sub

■オートフィルタの削除
Dim sh As Worksheet
For Each sh In Worksheets
sh.AutoFilterMode = False
Next sh

■行の挿入
Cells(行, 列).EntireRow.Insert

■列の挿入
Cells(行, 列).EntireColumn.Insert

■行選択
Rows(ActiveCell.Row).Select

■列選択
Columns(ActiveCell.Column).Select

■エクセル高速化 (画面を見せない)
Application.WindowState = xlMinimized 'エクセル本体を最小化
'Application.WindowState = xlMaximized 'エクセル本体を最大化
'Application.WindowState = xlNormal 'エクセル本体を通常表示

スポンサーリンク

スマホのみ下に表示