ExcelVBA セル関連

自分用のメモなので、形は整ってないです。

セルの書式を設定する　罫線、背景色、フォント、テキスト位置等

Cells(2, 5) = .Cells(1, 1).NumberFormatLocal  ' セルの書式
Cells(3, 5) = .Cells(1, 1).Borders.LineStyle  ' 罫線のスタイル
Cells(4, 5) = .Cells(1, 1).Interior.Color     ' 背景色
Cells(5, 5) = .Cells(1, 1).Font.Color         ' フォント色
Cells(6, 5) = .Cells(1, 1).Borders.Weight     ' 罫線の太さ



**************  書式   *************************

※ここから、細かい設定は無しでの書式設定
標準     .NumberFormatLocal = "G/標準"
数値     .NumberFormatLocal = "0_ "
通貨     .NumberFormatLocal = "¥#,##0;¥-#,##0"
会計     .NumberFormatLocal = "_ ¥* #,##0_ ;_ ¥* -#,##0_ ;_ ¥* "-"_ ;_ @_ "
日付     .NumberFormatLocal = "yyyy/m/d"
時刻     .NumberFormatLocal = "[$-F400]h:mm:ss AM/PM"
パーセンテージ    .NumberFormatLocal = "0%"
分数      .NumberFormatLocal = "# ?/?"
指数      .NumberFormatLocal = "0.E+00"
文字列    .NumberFormatLocal = "@"
その他(郵便番号)     .NumberFormatLocal = "[<=999]000;[<=9999]000-00;000-0000"
ユーザ設定(yyyy"年"m"月"d"日")     .NumberFormatLocal = "yyyy""年""m""月""d""日"""


'テキスト位置　※定数名が以前と変わっているかも
Cells(1, 1).HorizontalAlignment = xlHAlignCenter  '水平位置設定
Cells(1, 1).VerticalAlignment = xlVAlignCenter    '垂直位置設定

Debug.Print Cells(1, 1).HorizontalAlignment
Debug.Print Cells(1, 1).VerticalAlignment

'水平位置
'xlHAlignGeneral                1      標準(設定なし)。データの種類に従って揃える
'xlHAlignCenter                 -4108  中央揃え
'xlHAlignLeft                   -4131  左揃え
'xlHAlignRight                  -4152  右揃え
'xlHAlignCenterAcrossSelection  7      選択肢の中央揃え
'xlHAlignDistributed            -4117  均等割り付け
'xlHAlignFill                   5      ページ幅に合わせる
'xlHAlignJustify                -4130  両端揃え

'垂直位置
'xlvalignbottom        -4107  下揃え(標準)
'xlvaligncenter        -4108  中央揃え
'xlVAlignDistributed   -4117  均等割り付け
'xlvalignjustify       -4130  両端揃え
'xlvaligntop           -4160  上揃え


.WrapText = True   ' 折り返して全体表示


************   罫線   **************************

.Borders.LineStyle = xlContinuous   ' 普通の罫線
.Borders.LineStyle = True   ' 普通の罫線

.Borders.LineStyle = False   '罫線無し
.Borders.LineStyle = xlNone   '罫線無し


.Borders.Weight = xlThin   ' 普通の罫線の太さ
.Borders.Weight = xlMedium   ' 少し太い罫線

.Borders.Color = RGB(255, 10, 255)   ' 罫線色


************  背景色   *********************

.Interior.Color = RGB(150, 50, 200)    ' 背景色
.Interior.ColorIndex = 0    ' 背景色　標準
.Interior.ColorIndex = 1    ' 背景色　黒
.Interior.ColorIndex = 2    ' 背景色　白
.Interior.ColorIndex = 3    ' 背景色　赤
.Interior.ColorIndex = 4    ' 背景色　緑
.Interior.ColorIndex = 5    ' 背景色　青
.Interior.ColorIndex = 6    ' 背景色　黄


***************  フォント   ********************************

.Font.Color = RGB(150, 50, 200)    ' フォント色
.Font.ColorIndex = 0    ' フォント色　標準
.Font.ColorIndex = 1    ' フォント色　黒
.Font.ColorIndex = 2    ' フォント色　白
.Font.ColorIndex = 3    ' フォント色　赤
.Font.ColorIndex = 4    ' フォント色　緑
.Font.ColorIndex = 5    ' フォント色　青
.Font.ColorIndex = 6    ' フォント色　黄

.Font.Name = "メイリオ"   ' フォント名
.Font.Size = 16           ' フォントサイズ
.Font.Bold = True         ' 太字に

セルの選択(行･列の選択も含む)

Range("C3").Select
Cells(2, 2).Select

Range("A1:C6").Select
Range("A3:C4").Select
Range(Cells(2, 2), Cells(5, 5)).Select

Range("A1,B2,D4").Select  ' 複数セルをばらばらに選択
Range("A1:B5, D3:E8").Select    ' 複数の範囲選択

Range("範囲1").Select   ' 名前を付けた範囲を選択

Range("1:1").Select    ' 1行目全体を選択
Range("B:B").Select    ' B列全体を選択
Range("2:4").Select    ' 2～4行目を選択
Range("A:D").Select    ' A～D列を選択

Rows(3).Select      ' 3行目を選択
Columns(4).Select   ' 4列目を選択
Rows("1:3").Select  ' 複数行選択

' Columns("1:4").Select  ※これはできないらしい。列は以下の方法で
Range(Columns(1), Columns(5)).Select  ' 複数列選択。列1から列5の範囲を選択

' Cells指定を使って行・列全体を選択する場合の一例
Cells(2, 2).EntireRow.Select
Range(Cells(2, 2), Cells(4, 5)).EntireRow.Select
Range(Cells(1, 1), Cells(3, 3)).EntireColumn.Select


[A1:C5].Select     ' 省略した表記

上下左右各方向の、データのある最終セルを選択する

Cells(3, 3).End(xlUp).Select      ' 上方向
Cells(3, 3).End(xlDown).Select    ' 下方向
Cells(3, 3).End(xlToLeft).Select  ' 左方向
Cells(3, 3).End(xlToRight).Select ' 右方向

Cells(ActiveSheet.Rows.Count, 4).End(xlUp).Select    ' 4列目のデータのある最終セルを選択

※ただし、結合セルに関しては正しい結果にならないことがあるので注意



Sub nnn()
'結合セルがある場合は、以下のようにするといいかも

Dim ws As Worksheet
Dim mergeRange As Range  '結合している範囲
Dim i As Long
Dim lastRow As Long
Dim lastCol As Long
Dim tmpNum As Long

Set ws = ActiveSheet

lastRow = 1
For i = 1 To 10  '1列目～10列目までの最終行を取得
  tmpNum = ws.Cells(ws.Rows.Count, i).End(xlUp).row
  If ws.Cells(tmpNum, i).MergeCells = True Then  '結合しているセルの場合
    Set mergeRange = ws.Cells(tmpNum, i).MergeArea
    tmpNum = mergeRange(mergeRange.Rows.Count, mergeRange.Columns.Count).row
    '結合範囲の右下のセルの行番号を取得
  End If
  If lastRow < tmpNum Then
    lastRow = tmpNum
  End If
Next i
Debug.Print lastRow


lastCol = 1
For i = 1 To 10
  tmpNum = ws.Cells(i, ws.Columns.Count).End(xlToLeft).column
  If ws.Cells(i, tmpNum).MergeCells = True Then
    Set mergeRange = ws.Cells(i, tmpNum).MergeArea
    tmpNum = mergeRange(mergeRange.Rows.Count, mergeRange.Columns.Count).column
  End If
  If lastCol < tmpNum Then
    lastCol = tmpNum
  End If
Next i
Debug.Print lastCol

End Sub

アクティブセル領域の選択(CurrentRegion)

************      アクティブセル領域の選択(CurrentRegion)
基準のセルが含まれる範囲で、空白行、空白列、空白セルで取り囲まれている領域        **********

	Cells(7, 4).CurrentRegion.Select

使用済みの最終セルの選択(UsedRange)

***********************     使用済みの最終セルの選択(UsedRange)
   何らかの編集が行われているセル範囲を選択     *****************************
   
      ActiveSheet.UsedRange.Select
    ' データがある、罫線が設定されているなどのセル以外でも、セルの書式設定があるセル範囲も対象になるので注意

編集済みの最終セルの選択、その他特殊条件での選択(SpecialCells)

Cells(1, 1).SpecialCells(xlCellTypeLastCell).Select     ' 使われたセル範囲内の最後のセル

On Error Resume Next   ' 該当するセルが無い場合、エラーになることがある

Cells(1, 1).SpecialCells(xlCellTypeAllFormatConditions).Select     ' 表示形式が設定されているセル
Cells(1, 1).SpecialCells(xlCellTypeAllValidation).Select     ' 条件の設定が含まれているセル
Cells(1, 1).SpecialCells(xlCellTypeBlanks).Select     ' 空の文字列
Cells(1, 1).SpecialCells(xlCellTypeComments).Select     ' コメントが含まれているセル
Cells(1, 1).SpecialCells(xlCellTypeConstants).Select     ' 定数が含まれているセル
Cells(1, 1).SpecialCells(xlCellTypeFormulas).Select     ' 数式が含まれているセル
Cells(1, 1).SpecialCells(xlCellTypeSameFormatConditions).Select     ' 同じ表示形式が設定されているセル
Cells(1, 1).SpecialCells(xlCellTypeSameValidation).Select     ' 同じ条件の設定が含まれているセル
Cells(1, 1).SpecialCells(xlCellTypeVisible).Select     ' すべての可視セル

On Error GoTo 0

セルに文字列データの数値を設定する

Cells(3, 3).Value = "'1000"
' 文字列扱いの数値になるので、左詰の表示になる。セルの書式設定は標準のまま

Cells(3, 4).Value = "2000"  ' 普通に右詰になる
Cells(3, 5).Value = 5000    ' こちらもに右詰になる

セルに数式を設定する

Cells(1, 1).Formula = "=B1+B2"
Cells(1, 1).Formula = "=$B$3+$B$4"    ' 絶対参照
Cells(1, 1).Formula = "=SUM(B1:B5)"

Cells(1, 1).FormulaR1C1 = "=R[2]C[1] + R[3]C[1]"   ' R1C1形式

'変数を使ってR1C1にしたいなら、これくらいしかないかな

Dim int1 As Integer
Dim int2 As Integer
int1 = 3
int2 = -9

Cells(1, 10).FormulaR1C1 = "=R[" & int1 & "]C[" & int2 & "]"

セル・セル範囲のコピー・貼り付け　　形式を選択して貼り付けの説明もあり

' 単純なコピー・貼り付け
Range(Cells(1, 1), Cells(3, 1)).Select
Selection.Copy
Cells(1, 2).Select
ActiveSheet.Paste

' 貼り付け先を指定
Range(Cells(1, 1), Cells(3, 1)).Copy Destination:=Cells(1, 3)
Worksheets(1).Range(Cells(1, 1), Cells(3, 1)).Copy Destination:=Worksheets(2).Cells(1, 3)

' これでもOK
Worksheets(1).Range(Cells(1, 1), Cells(3, 1)).Copy Worksheets(2).Cells(1, 3)

' 値のみのコピーなら、この方法でもいい
Range(Cells(1, 2), Cells(5, 2)).Value = Range(Cells(1, 1), Cells(5, 1)).Value


' 形式選択して貼り付け
Worksheets(1).Range(Cells(1, 1), Cells(5, 1)).Copy
Worksheets(2).Cells(1, 1).PasteSpecial Paste:=xlPasteAll   ' すべて
Worksheets(2).Cells(1, 2).PasteSpecial Paste:=xlPasteFormulas   ' 数式
Worksheets(2).Cells(1, 3).PasteSpecial Paste:=xlPasteValues   ' 値
Worksheets(2).Cells(1, 4).PasteSpecial Paste:=xlPasteFormats    ' 書式
Worksheets(2).Cells(1, 5).PasteSpecial Paste:=xlPasteComments    ' コメント
Worksheets(2).Cells(1, 6).PasteSpecial Paste:=xlPasteValidation   ' 入力規則
Worksheets(2).Cells(1, 7).PasteSpecial Paste:=xlPasteAllExceptBorders   ' 罫線を除く全て
Worksheets(2).Cells(1, 8).PasteSpecial Paste:=xlPasteColumnWidths       ' 列幅
Worksheets(2).Cells(1, 9).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats     ' 数式と数値の書式
Worksheets(2).Cells(1, 10).PasteSpecial Paste:=xlPasteFormulasAndNumberFormats   ' 値と数値の書式

セルのクリア

Cells(1, 1).Clear   ' 全てクリア
Cells(1, 1).ClearComments   ' コメント
Cells(1, 1).ClearContents   ' 値と数式
Cells(1, 1).ClearFormats   ' 書式 (色や罫線、条件付き書式など)
Cells(1, 1).ClearOutline   ' アウトライン
Cells(1, 1).ClearHyperlinks   ' ハイパーリンク

選択しているセル範囲を変更･移動する Offset　Resize

Sub aaa()

'*********  Offset  ***********
Range(Cells(1, 1), Cells(5, 5)).Select

Selection.Offset(2, 3).Select
'選択している範囲から、行方向へ2(下方向)、列方向へ3(右方向)だけ範囲を移動する

Selection.Offset(-1, -2).Select
'選択している範囲から、行方向へ-1(上)、列方向へ-2(左)だけ範囲を移動する

'Cells(1, 1).Select
'Selection.Offset(-1, -2).Select  これはマイナスのアドレスになるのでエラーが発生する。注意

Range(Cells(1, 1), Cells(3, 3)).Offset(3, 2).Select
'セル範囲に対してOffsetを指定することも可能

Range(Cells(1, 1), Cells(3, 3)).Offset(2).Select
'移動が0の場合は省略できる。これは行方向へ2

Range(Cells(1, 1), Cells(3, 3)).Offset(, 2).Select
'これは列方向へ2

End Sub


Sub bbb()

'*********  Riseze  ***********
Range(Cells(1, 1), Cells(5, 5)).Select

Selection.Resize(2, 3).Select
'選択している範囲の左上端のセルを基準にして、2行分、3列分の範囲を選択する

Range(Cells(1, 1), Cells(5, 5)).Select
Selection.Resize(2).Select
'列数を省略すると、列に関しては元の範囲と同じになる

Range(Cells(1, 1), Cells(5, 5)).Select
Selection.Resize(, 2).Select
'これは行の範囲が元の範囲と同じになる

'Resizeでマイナス数値を指定することは無い

End Sub


Sub ccc()

Cells(1, 1).CurrentRegion.Select
Selection.Resize(Selection.Rows.Count - 1).Offset(1).Select
'Cells(1, 1)のデータ範囲で、1行目を除いた部分を選択する例
'表の1行目はタイトルである事が多いので、データ部分だけを選択するのに使える

Dim range1 As Range
Set range1 = Cells(1, 1).CurrentRegion

range1.Resize(range1.Rows.Count - 1).Offset(2, 2).Select
range1.Resize(range1.Rows.Count - 2).Offset(3).Select
'Rangeオブジェクトに対して実行も可能

Set range1 = Range(Cells(1, 1), Cells(5, 5))
range1.Resize(1).Select  '一番上の1行だけ選択
range1.Resize(, 1).Select '一番左の1列だけ選択

range1.Offset(range1.Rows.Count - 1).Resize(1).Select
'これはややこしいが、range1の最終行だけ選択

range1.Offset(, range1.Columns.Count - 1).Resize(, 1).Select
'range1の最終列だけ選択



'※結合セルに対してはOffsetやResizeは正常に働かないという情報があるが、修正された？

'A11～A13と、B10～D10は結合してある
Range("A10").Select
Debug.Print Selection.Offset(1).Address  '$A$11
Debug.Print Selection.Offset(2).Address  '$A$12
Debug.Print Selection.Offset(3).Address  '$A$13
Debug.Print Selection.Offset(4).Address  '$A$14

Debug.Print "------------------------"

Debug.Print Selection.Offset(, 1).Address  '$B$10
Debug.Print Selection.Offset(, 2).Address  '$C$10
Debug.Print Selection.Offset(, 3).Address  '$D$10
Debug.Print Selection.Offset(, 4).Address  '$E$10

Selection.Resize(5).Select  '正常に5セルが選択されている

End Sub

行･列の表示・非表示

Rows(3).Hidden = True
Columns(5).Hidden = True

Rows.Hidden = False    ' 全ての行の再表示
Columns.Hidden = False

Range(Cells(1, 1), Cells(3, 3)).EntireRow.Hidden = True   ' 複数行を非表示にするにはこれくらいしかない？

特定のセルを選択する　　空白のセル、数式のあるセル等

' 該当するセルが無いとエラーになるので注意
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).Select  ' 空白セル
Selection.SpecialCells(xlCellTypeAllFormatConditions).Select  ' 条件付書式が設定されているセル
Selection.SpecialCells(xlCellTypeAllValidation).Select  ' 入力規則が設定されているセル
Selection.SpecialCells(xlCellTypeComments).Select  ' コメントのあるセル
Selection.SpecialCells(xlCellTypeConstants).Select  ' 定数が入力されているセル
Selection.SpecialCells(xlCellTypeFormulas).Select  ' 数式が入力されているセル
Selection.SpecialCells(xlCellTypeLastCell).Select  ' 使用されているセル範囲内で最後のセル
Selection.SpecialCells(xlCellTypeSameFormatConditions).Select  ' 同じ条件付書式が設定されているセル
Selection.SpecialCells(xlCellTypeSameValidation).Select  ' 同じ入力規則が設定されているセル
Selection.SpecialCells(xlCellTypeVisible).Select  ' 可視セル

' xlCellTypeConstants xlCellTypeFormulasは第二引数が指定できる
Selection.SpecialCells(xlCellTypeConstants, xlNumbers).Select ' 定数が入力されていて、数値データのセル
Selection.SpecialCells(xlCellTypeConstants, xlTextValues).Select ' 定数が入力されていて、文字列データのセル
Selection.SpecialCells(xlCellTypeConstants, xlErrors).Select ' 定数が入力されていて、エラー値のセル
Selection.SpecialCells(xlCellTypeConstants, xlLogical).Select ' 定数が入力されていて、論理値のセル

On Error GoTo 0

セル範囲に名前を定義する

ブック範囲に設定する名前と、シート範囲に設定する名前があることに注意　　名前はやたらと数が多くなることもあるので、削除の仕方はリンク2を参考に

ActiveWorkbook.Names.Add name:="エリア1", RefersToLocal:="=シート1!$A$1:$B$5"
'「シート1」シートのA1:B5の範囲に、ブック範囲の名前を「エリア1」として定義する
'シート範囲の名前でないことに注意

ActiveWorkbook.Names.Add name:="エリア2", RefersToR1C1:="=シート1!R6C1:R10C2"
'「シート1」シートのA6:B10の範囲に、ブック範囲の名前を「エリア2」として定義する

ActiveWorkbook.Names.Add name:="エリア2", RefersToR1C1:="=シート1!R6C1:R10C2"
'同じ範囲に同じ名前を付けてもエラーにならないらしい

ActiveWorkbook.Names.Add name:="エリア2", RefersToR1C1:="=シート1!R20C1:R25C2"
'違う範囲に同じ名前で定義すると、再定義になるらしい


ActiveWorkbook.Worksheets("シート2").Names.Add name:="エリア3", RefersToLocal:="=シート2!$C$1:$D$5"
'シート範囲の名前を定義する


Debug.Print ActiveWorkbook.Names.Count  '名前の数   3

Dim obj1 As Object
For Each obj1 In ActiveWorkbook.Names  ' Namesコレクションを走査
  Debug.Print obj1  ' =シート1!$A$1:$B$5 のように出力される
Next obj1


ActiveWorkbook.Names("エリア2").Delete  ' ブック範囲の名前を、名前指定で削除

ActiveWorkbook.Names(1).Delete  'インデックス番号で指定　インデックスは1から始まる

ActiveWorkbook.Worksheets("シート2").Names("エリア3").Delete


ActiveWorkbook.Names.Add name:="エリア4", RefersToLocal:="=シート1!$A$1:$B$5"
ActiveWorkbook.Names.Add name:="エリア5", RefersToLocal:="=シート1!$A$1:$B$5"
ActiveWorkbook.Names.Add name:="エリア6", RefersToLocal:="=シート1!$A$1:$B$5"
'適当に3つの名前定義

'ActiveWorkbook.Names.Delete   エラーになる。これで全削除とはいかないらしい

For Each obj1 In ActiveWorkbook.Names  '全削除はこれで
  obj1.Delete
Next obj1

Debug.Print ActiveWorkbook.Names.Count    ' 0

Aのセル範囲とBのセル範囲の、共通のセル範囲を取得する(Intersect)

Dim range1 As Range

Set range1 = Application.Intersect(Range("A1:C10"), Range("B5:D15"))
' 2つのセル範囲の共有範囲を取得
If Not range1 Is Nothing Then  ' 共有範囲がある場合
    MsgBox "共有範囲は " & range1.Address
Else
    MsgBox "共有範囲はありません"
End If

選択されているセル範囲の、先頭セルと末尾セルの行列番号、行数・列数を取得

Debug.Print Selection(1).Row   '選択範囲の先頭(左上端)セルの行番号
Debug.Print Selection(1).Column    '選択範囲の先頭(左上端)セルの列番号
Debug.Print Selection(Selection.Count).Row    '選択範囲の末尾(右下端)セルの行番号
Debug.Print Selection(Selection.Count).Column    '選択範囲の末尾(右下端)セルの列番号


'以下の方法でもいい
Debug.Print Selection.Row   '選択範囲の先頭(左上端)セルの行番号
Debug.Print Selection.Column

Debug.Print Selection.Rows.Count       ' 選択範囲の行数
Debug.Print Selection.Columns.Count    ' 選択範囲の列数

Debug.Print "選択されている範囲は: " & Selection.Row & "行" & Selection.Column & "列～" & _
Selection.Row + Selection.Rows.Count - 1 & "行" & Selection.Column + Selection.Columns.Count - 1 & "列 です"


' .Item を使う方法
Dim message As String
With Selection
  message = message & .Rows.Count & "行、" & .Columns.Count & "列　分の範囲" & vbCrLf
  message = message & "セル数： " & .Count & vbCrLf
  message = message & "先頭のセル: " & .Item(1).Address(0, 0) & vbCrLf  ' 選択範囲の先頭セル
  message = message & "末尾のセル: " & .Item(.Count).Address(0, 0)      ' 選択範囲の末尾セル
End With
Debug.Print message   ' 選択範囲の情報を表示

セルが選択されているかを確認する

If TypeName(Selection) = "Range" Then
    Selection.Interior.ColorIndex = 5
Else
    MsgBox "セルが選択されていません"
End If

' 選択されているセル範囲を対象にする場合は、このコードが必須かな

行幅・列幅をデータに合わせて自動調整する

Rows(30).AutoFit
' 行30内で、最もデータの高さが大きいセルに合わせて、行の高さを自動調整

Range(Cells(26, 1), Cells(28, 1)).EntireRow.AutoFit
' 行26、行27、行28のそれぞれの内で、最もデータの高さが大きいセルに合わせて、それぞれの行の高さを自動調整(3行とも同じ高さになるのではない)


Cells(33, 1).Columns.AutoFit
' Cells(33, 1)のデータの幅に合わせて、列1の幅を自動調整
' 1つのセルを指定して自動調整できるのは列のみらしい。行には無い

Columns(11).AutoFit
' 列11内で、最もデータの幅が大きいセルに合わせて、列の幅を自動調整

Range(Cells(1, 12), Cells(1, 14)).EntireColumn.AutoFit
' 列12、列13、列14のそれぞれの内で、最もデータの幅が大きいセルに合わせて、それぞれの列の幅を自動調整(3列とも同じ幅になるのではない)

結合セル関連

Application.DisplayAlerts = False

Range(Cells(1, 1), Cells(3, 3)).Merge   ' セルの結合

Range(Cells(2, 2), Cells(2, 2)).UnMerge
' セルの結合解除。結合しているセル範囲の一部を指定するだけで、結合解除できるみたい


Range(Cells(1, 1), Cells(3, 3)).Merge
If Cells(2, 2).MergeCells = True Then    ' セルが結合されているかを調べる。Trueで結合セル
    MsgBox "結合されています"
Else
    MsgBox "結合されていません"
End If


Dim range1 As Range
Set range1 = Cells(2, 2).MergeArea   ' 結合している範囲を取得

Dim message As String
With range1
    message = message & .Rows.Count & "行、" & .Columns.Count & "列　分の範囲" & vbCrLf
    message = message & "セル数： " & .Count & vbCrLf
    message = message & "左上のセル: " & .Item(1).Address(0, 0) & vbCrLf  ' セル範囲の先頭セル
    message = message & "右下のセル: " & .Item(.Count).Address(0, 0)      ' セル範囲の末尾セル
End With
MsgBox message   ' 結合セル範囲の情報を表示


Application.DisplayAlerts = True

セルのアドレスを取得する

Range("A1").Select
Debug.Print "①行列の絶対参照" & vbTab & ActiveCell.Address
' $A$1

Debug.Print "②行のみ相対参照" & vbTab & ActiveCell.Address(RowAbsolute:=False)
' $A1  ActiveCell.Address(0) と省略可能

Debug.Print "③列のみ相対参照" & vbTab & ActiveCell.Address(ColumnAbsolute:=False)
' A$1  ActiveCell.Address(,0) と省略可能

Debug.Print "④行列の相対参照" & vbTab & ActiveCell.Address(RowAbsolute:=False, ColumnAbsolute:=False)
' A1  ActiveCell.Address(0,0) と省略可能

Debug.Print "⑤R1C1形式  " & vbTab & vbTab & ActiveCell.Address(ReferenceStyle:=xlR1C1)
' R1C1

Debug.Print "⑥外部参照形式" & vbTab & vbTab & ActiveCell.Address(External:=True)
' [VBAXXX.xlsm]セル!$A$1

Debug.Print "⑦B5からの相対参照" & vbTab & ActiveCell.Address(ColumnAbsolute:=False, RowAbsolute:=False, _
            ReferenceStyle:=xlR1C1, Relativeto:=Cells(5, 2))
' R[-4]C[-1]

セルに普通の格子罫線を設定する

Range("A1:E10").Borders.LineStyle = True
' 普通の格子罫線を設定する

Range("A1:E10").Borders.LineStyle = False
' 罫線を消す

セルの値ではなく、表示されている文字列を取得する

' Cells(1, 1) に、「1000」と入力、セルの書式設定は通貨型としておく。セルに表示されている文字列は「\1,000」になっている

MsgBox Cells(1, 1).Value  ' 「1000」と表示。書式は関係無しに、値の取得になる
MsgBox Cells(1, 1).Text   ' 「\1,000」


' Cells(2, 2) に、「2017/2/2」と入力、セルの書式設定は日付で、フォーマットは「yyyy年m月d日」としておく。
' セルに表示されている文字列は「2017年2月2日」になっている

MsgBox Cells(2, 2).Value    ' 「2017/02/02」と表示
MsgBox Cells(2, 2).Text     ' 「2017年2月2日」と表示
MsgBox Cells(2, 2).Value2   ' 「42768」と表示。.Value2 で、日付のシリアル値を取得できる

日付が入力されているセルの、日付のシリアル値を取得する

' Cells(2, 2) に、「2017/2/2」と入力、セルの書式設定は日付で、フォーマットは「yyyy年m月d日」としておく。
' セルに表示されている文字列は「2017年2月2日」になっている

MsgBox Cells(2, 2).Value    ' 「2017/02/02」と表示
MsgBox Cells(2, 2).Text     ' 「2017年2月2日」と表示
MsgBox Cells(2, 2).Value2   ' 「42768」と表示。.Value2 で、日付のシリアル値を取得できる

セル以外(図形・グラフなど)が選択されている状態で、選択済みのセル範囲を取得する

' セル(A1:C3)を選択し、そのあと図形を選択した状態で

Dim range1 As Range

For Each range1 In ActiveWindow.RangeSelection
' 選択済みのセル範囲を取得する
    range1.Interior.ColorIndex = 3
Next range1

離れている複数のセル範囲を取得、結合する　AreasとUnion

Sub aaa()

Dim range1 As Range
Dim range2 As Range
Dim rowsCnt As Long
Dim i As Long

Range("A1:C20").Clear

Set range1 = Range("A1:C3, A7:C11")  '離れている2つのセル範囲をSet
range1.Interior.ColorIndex = 4

Debug.Print range1.Rows.Count  '3になる。8行分選択されているはずだが


rowsCnt = 0
For i = 1 To range1.Areas.Count
'Areas.Countでセル範囲の数を取得。今回の場合は2

  Set range2 = range1.Areas(i)  'range2に、range1のi番目の範囲をセット
  rowsCnt = rowsCnt + range2.Rows.Count
Next i

Debug.Print rowsCnt  '8　正確に行数を取得できる

Debug.Print "----------------------"

'**********   Unionで複数の範囲を結合する  *******

Range("A1:C20").Clear
Set range1 = Range(Cells(1, 1), Cells(3, 3))
Set range1 = Union(range1, Range(Cells(7, 1), Cells(12, 3)))
'Unionで2つの範囲を結合する
'Set range1 = (range2,range3)  というコードは不可らしいので、Unionで

Set range1 = Union(range1, Range(Cells(16, 1), Cells(20, 3)))
range1.Interior.ColorIndex = 5

rowsCnt = 0
For i = 1 To range1.Areas.Count
  Set range2 = range1.Areas(i)
  rowsCnt = rowsCnt + range2.Rows.Count
Next i
Debug.Print rowsCnt  '14

Debug.Print "----------------------"


Range("A1:C20").Clear
Set range1 = Range(Cells(1, 1), Cells(3, 3))
Set range1 = Union(range1, Range(Cells(2, 1), Cells(7, 3)))
'重複する部分がある2つの範囲を結合する
range1.Interior.ColorIndex = 3

rowsCnt = 0
For i = 1 To range1.Areas.Count
  Set range2 = range1.Areas(i)
  rowsCnt = rowsCnt + range2.Rows.Count
Next i
Debug.Print rowsCnt  '7になる。重複する部分は2重にカウントされていない

'重複する部分がある2つの範囲を結合した場合は、重複部分は吸収されるらしい


End Sub

セルの値で検索する Find 　実はあまり使えない?

Dim range1 As Range

Set range1 = Cells.Find(What:="CCC")
' シート全体を対象として、セルの値が "CCC" であるセルを取得
' 対象のセルが複数ある場合は、最初に見つかったセルになる

If range1 Is Nothing Then   ' 該当するセルが無い場合
    MsgBox "指定のセルは見つかりません"
Else
    MsgBox range1.Address
End If


Set range1 = Range("D1:D20").Find(What:="AAA", LookAt:=xlWhole, MatchCase:=True)
' Range("D1:D20") を検索範囲、セルの値が完全一致、大文字小文字の区別をする
' 注意点として、セル範囲の先頭のセルは、検索順番が最後になるということ。セルD1とD3の値が"AAA"だった場合、range1はD3になる

Set range1 = Range("D1:D20").Find(What:="アイウ", LookAt:=xlPart, MatchByte:=True)
' セルの値が部分一致、全角半角の区別をする

Set range1 = Cells.Find(What:="333", After:=Range("A2"), SearchOrder:=xlByRows)
' 検索を開始するセルをA2以降に、検索方向を行方向にする
' After:=で指定できるのは1セルのみ。そのセルは検索対象にならない
' 紛らわしいが、SearchOrder:=xlByRows とすると横(右)方向に検索していくらしい。SearchOrder:=xlByColumns で列(下)方向になる

' ※他にもパラメータはあるが、使うのはこれくらいかな


' ※対象のセルが複数ある場合は、FindNextで次のセルを取得できる。以下は対象セル全てを取得する例

Dim unionRange As Range   ' 検索で見つかったセルをまとめたセル範囲
Dim findRange As Range
Dim firstRange As Range

Set findRange = Cells.Find(What:="111")
If findRange Is Nothing Then
    MsgBox "該当セルなし"
Else
    Set firstRange = findRange   ' 最初に見つかったセルを保存しておく
    Do
        If unionRange Is Nothing Then  ' 最初はNothingなので、そのための処理
            Set unionRange = findRange
        Else
            Set unionRange = Union(unionRange, findRange)
        End If

        Set findRange = Cells.FindNext(findRange)
        ' 同じ条件で、次の該当セルを検索する
        If findRange Is Nothing Then
            Exit Do  ' 次のセルが見つからない場合は、ループを抜ける
        End If

    Loop Until findRange.Address = firstRange.Address
    ' 最初に見つかったセルに戻るまで、検索を続ける

End If

For Each range1 In unionRange  ' 検索で見つかったセルを対象
    range1.Interior.ColorIndex = 5
Next range1


' ※処理の高速化をしたいなら、ワークシート関数や配列を利用する方法もあり。詳しくはリンク3を参照
' 例えば、以下のようなやり方もありかな
Dim var1 As Variant

Set range1 = Range(Cells(1, 1), Cells(5, 5))
For Each var1 In range1
    If var1.Value Like "*1*" Then   ' 部分一致で検索
        Debug.Print var1.Address(0, 0)
    End If
Next var1

セルの文字列の一部を、フォント色変更する

Range("A1").Value = "ABCDEFGHIJK"
Range("A1").Characters(Start:=3, Length:=5).Font.ColorIndex = 3
' 文字列の3文字目から、5文字分のフォント色を赤に変更
' 文字列として認識されないと駄目。.Value = 123456789 のようにしても無効


Range("B2").Value = "'123456789"   ' 数値を入れるなら、"'"をつけて文字列扱いにすればOK
Range("B2").Characters(Start:=2, Length:=4).Font.ColorIndex = 3

行･列の削除

Rows(1).Delete   ' 行1を削除

Range(Cells(1, 1), Cells(3, 3)).EntireRow.Delete
' 選択されたセル範囲の、行全体を削除する。結果として行1～行3が削除される

Columns(2).Delete   ' 列2を削除

Range(Cells(3, 3), Cells(5, 5)).EntireColumn.Delete
' 選択されたセル範囲の、列全体を削除する。結果として列3～列5が削除される

行･列の挿入

Rows(2).Insert   ' 2行目の位置に、行追加

Rows("3:5").Insert    ' 3行目の位置に、3行追加

' ※挿入した行の書式が、挿入位置の上の行を引き継いでしまうので注意

Columns(2).Insert   ' 2列目の位置に、1列追加

' Columns("4:6").Insert   ※これはできない。行だとできるのに？

Range(Cells(2, 2), Cells(3, 3)).EntireRow.Insert
Range(Cells(2, 2), Cells(3, 3)).EntireColumn.Insert
' これはどちらもできる。複数列の挿入をするなら、これかな

行･列のコピー　値で行･列を貼り付ける方法も含む

Rows(5).Copy (Rows(8))
' 一番シンプルな表記。5行目をコピーして、8行目に貼り付け。行の書式等もコピーされる


' ※複数行をコピーするなら､以下のやり方がいいと思う
Range(Cells(1, 1), Cells(3, 1)).EntireRow.Copy    ' 1行目～3行目全体をコピー
Range(Cells(6, 10), Cells(8, 15)).EntireRow.PasteSpecial (xlPasteValues)
' 6行目～8行目全体を選択になる。先頭セルでなくとも構わない。.PasteSpecial (xlPasteValues) で、値で行を貼り付け


' ※行をコピーして挿入するなら､以下のようなやり方かな｡完璧ではないが
Range(Cells(6, 1), Cells(8, 1)).EntireRow.Insert   ' 6行目の位置に、3行を挿入
Range(Cells(6, 1), Cells(8, 1)).EntireRow.Clear    ' 挿入した行の書式が、挿入位置の上の行を引き継いでしまうので、クリアする
Range(Cells(1, 1), Cells(3, 1)).EntireRow.Copy
Range(Cells(6, 10), Cells(8, 15)).EntireRow.PasteSpecial (xlPasteValues)


' ※列も行と全く同じ
Columns(2).Copy (Columns(4))

オートフィルを利用する

Range("A1").AutoFill Destination:=Range("A1:A20")
' セルA1から、オートフィルでA20まで連続データを作る

Range("A1").AutoFill Destination:=Range("A1").Resize(20, 1)
' これでも上と同じ意味。A1セルを行20・列1の範囲に広げるという意味になるらしい
' 下方向に広げるなら、Resize(20, 1) は Resize(20)に省略可能

Range("A1").AutoFill Destination:=Range("A1").Resize(1, 10)
' 列方向(右)へ10広げる

Range("A1").AutoFill Destination:=Range("A1").Resize(20), Type:=xlFillSeries    ' 連続データ(デフォルト)
Range("A1").AutoFill Destination:=Range("A1").Resize(20), Type:=xlFillCopy      ' 値のコピー
Range("A1").AutoFill Destination:=Range("A1").Resize(20), Type:=xlFillFormats   ' 書式のみコピー
Range("A1").AutoFill Destination:=Range("A1").Resize(20), Type:=xlFillValues    ' 書式はコピーせずに連続データ


Range("A1:B1").AutoFill Destination:=Range("A1:B1").Resize(20, 2)
' 2列をオートフィルで連続データ作成

Range("A1:A2").AutoFill Destination:=Range("A1:A2").Resize(2, 10)
' 複数行を右方向に広げることも可能

セル内改行(alt + Return で改行)した場合の、改行コードについての注意

Range("A1").Value = "AAA" & vbLf & "BBB"
' セル内で、alt + Return で改行した場合、改行コードは「vbLf」になる
' したがって上のコードは、手動で "AAA" alt + Return で改行 "BBB" としたのと同じ結果になる


Open "C:\まとめ総合\ExcelVBA\サンプルテキスト\改行テスト.txt" For Output As #1
    Print #1, Range("A1").Value
Close #1

' セルA1の値をテキストファイルに書き込んでみる。
' サクラエディタで開くと、改行コードがCRLFではなく、LFになっている。これはまだいいが、
' メモ帳で開くと、"AAA"と"BBB"の間が改行されていない。これはWindowsの標準改行コードがvbCrLf(CRLF)だから。これは困る

'　※なので、手動でセル内改行してあるデータをテキストファイルなどに出力する場合は、事前に以下の処理をするといい
Range("A1").Value = Replace(Range("A1").Value, vbLf, vbCrLf)

Open "C:\まとめ総合\ExcelVBA\サンプルテキスト\改行テスト2.txt" For Output As #1
    Print #1, Range("A1").Value
Close #1
' これでメモ帳で開いても、改行が入っている

ハイパーリンクの設定

With ActiveSheet
    
    .Hyperlinks.Add Anchor:=Cells(1, 1), Address:="C:\まとめ総合\ExcelVBA\サンプルテキスト\0100.txt"
    ' セルA1に、ファイルへのハイパーリンクを設定する

    .Hyperlinks.Add Anchor:=Cells(2, 1), Address:="C:\まとめ総合\ExcelVBA\サンプルテキスト\0100.txt", TextToDisplay:="HLink_2"
    ' セルA2に、"HLink_2"の名前でハイパーリンクを設定。セルの値が変更されるわけではない

    .Hyperlinks(1).Delete
    ' ハイパーリンクコレクションの1番目を削除(セル番地を指定しての削除は出来ない？)

    .Hyperlinks("HLink_2").Delete
    ' ハイパーリンクの名前で指定して削除

    .Hyperlinks.Delete  ' シート内のハイパーリンクを全て削除


    .Hyperlinks.Add Anchor:=Cells(3, 1), Address:="", SubAddress:="設定!A100"
    ' 同ブックの「設定」シート、セルA100にリンク設定。Address:="" は省略してはいけない
    ' "設定!A100" は "設定!R100C1" としてもいい
    
    .Hyperlinks.Add Anchor:=Cells(4, 1), Address:="C:\まとめ総合\ExcelVBA\aaa.xlsx", SubAddress:="シート1!A10"
    ' 他のブックへのリンク

End With

指定のセル位置へスクロールする

With ActiveWindow
    .ScrollRow = 20
    .ScrollColumn = 5
    ' cell(20,5)が、画面の左上に来るようにスクロールする
End With

セルに数式が入っているかを判定する　　HasFormula

Debug.Print Cells(1, 2).HasFormula
'数式が入っていればTrue、無ければFalse
'セルの書式が文字列だと、数式の文字列が入っていても数式とは判定されない

Debug.Print WorksheetFunction.IsFormula(Cells(1, 2))
'これでもいいらしい

あるセル範囲を指定したRange内で、A1セルの値と違う値が入っているセルを全て取得する

Dim range1 As Range

Range("A1").Value = "AAA"
Range("A2").Value = "CCC"
Range("A3").Value = "AAA"
Range("A4").Value = "DDD"

Set range1 = ActiveSheet.Columns("A").ColumnDifferences(Comparison:=ActiveSheet.Range("A1"))
'A列内で、A1セルと値が違うセルを全てrange1に格納する　空白セルは無視される
range1.Select

'Set range1 = ActiveSheet.Columns("A").ColumnDifferences("AAA")  こういう指定はできないらしい

Set range1 = ActiveSheet.Range("A1:A4").ColumnDifferences(Comparison:=ActiveSheet.Range("A1"))
'これでもいい
range1.Select

セルのValueは、Variant型になっているらしい。クリアされたセルの値は、空文字や0と一致すると判定されることに注意

Sub aaaa()

'セルのValueというのは、Variant型になっているらしい
'クリアされたセルの値は、= 0 がTrueと判定されることは注意が必要

Cells.Clear  '全てクリア

Debug.Print VarType(Cells(1, 1).Value)  '0  Empty値

Debug.Print Cells(1, 1).Value = ""
'True  Trueになるのは、自動変換されているから。セルの値が空文字であるということではない

Debug.Print Cells(1, 1).Value = 0
'True　　これも自動変換でTrueと判定される。これは十分に注意を

Debug.Print "-----------------------------"

Cells(1, 1).Value = 100
Debug.Print VarType(Cells(1, 1).Value)   '5   Double型

Cells(1, 1).Value = ""
Debug.Print VarType(Cells(1, 1).Value)  '0  Empty値  文字列ではないらしい

Cells(1, 1).Value = "123"
Debug.Print VarType(Cells(1, 1).Value)  '5   Double型  これも文字列ではないのか

Cells(1, 1).Value = "AAA123"
Debug.Print VarType(Cells(1, 1).Value)  '8   文字列型

Cells(1, 1).Value = "1/2"
Debug.Print VarType(Cells(1, 1).Value)  '7   日付型になっている

Cells(1, 1).ClearContents
Debug.Print VarType(Cells(1, 1).Value)  '0  Empty値

Debug.Print "-----------------------------"

Cells.Clear
Cells(1, 1).Value = 100
Cells(1, 2).Formula = "=RC[-1]*200"  '数式を入れる
Debug.Print VarType(Cells(1, 2).Value)  '5   Double型

End Sub

セル範囲の値をVariant型へ格納し、配列として扱う

高速処理だが、結合セルがあった場合や、1セルのみの範囲だった場合は注意が必要

'セル範囲の値をVariantへ格納
Sub aaa()

Dim var1 As Variant
Dim var2 As Variant
Dim i As Long
Dim j As Long

ActiveSheet.Cells.Clear  '全てクリア

ActiveSheet.Range(Cells(1, 1), Cells(10, 5)).Value = 123
var1 = ActiveSheet.Range(Cells(1, 1), Cells(10, 5)).Value
' セル範囲をバリアント変数に格納すると、二次元配列の形になる
'アクティブなシートでないとエラーになるので注意

Debug.Print UBound(var1, 1)  '10  1次元目の要素数
Debug.Print UBound(var1, 2)  '5   2次元目の要素数

Debug.Print "------------------------------"

For i = 1 To 10
' var1は二次元配列の形になっているが、インデックスは0ではなく1から始まるので注意
  For j = 1 To 5
    Cells((i + 10), j).Value = var1(i, j)
    ' セルにvar1のデータを格納していく
  Next j
Next i

'配列の1次元目と2次元目の要素数を利用してループしてもいい
For i = LBound(var1, 1) To UBound(var1, 1)
  For j = LBound(var1, 2) To UBound(var1, 2)
    Debug.Print var1(i, j)
  Next j
Next i

Debug.Print "------------------------------"

Range(Cells(21, 1), Cells(30, 5)).Value = var1
' 一括でセル範囲にデータを格納する方法

  
'1セルのみの範囲だった場合は、バリアント型変数の内容は配列にならない
'*次元目の要素数を取得しようとするとエラーになる
var2 = ActiveSheet.Range(Cells(1, 1), Cells(1, 1)).Value
On Error Resume Next
Debug.Print UBound(var2, 1)  'このコードはエラー
If Err.Number <> 0 Then MsgBox "エラー"
On Error GoTo 0
'※配列の要素数の取得時には、必ずエラートラップをするべき


'以下のようにVarTypeで判定するのもありかも
var1 = ActiveSheet.Range(Cells(1, 1), Cells(10, 5)).Value
var2 = ActiveSheet.Range(Cells(1, 1), Cells(1, 1)).Value
Debug.Print VarType(var1)  '8204  バリアント配列は、「8192+12」になるらしい。セルの値は関係しないみたい
Debug.Print VarType(var2)  '5     これはセルの値による

End Sub




'セルに数式を入れてVariantへ格納
Sub bbb()

Dim var1 As Variant
Cells.Clear  '全てクリア

Cells(1, 1).Value = 100
Cells(1, 2).Formula = "=RC[-1]*200"  '数式のセルにする

var1 = Range(Cells(1, 1), Cells(1, 2)).Value
Debug.Print var1(1, 1)   '100
Debug.Print var1(1, 2)   '20000   数式のセルでも、値の取得はできる
Debug.Print VarType(var1(1, 1))  '5   Double型
Debug.Print VarType(var1(1, 2))  '5   Double型

Cells(1, 3) = var1(1, 2) / 20
Debug.Print Cells(1, 3).Value  '1000  普通に計算できるみたい

End Sub


'選択している範囲をVariantへ格納
Sub ccc()

Dim var1 As Variant
Dim i As Long
Dim j As Long

Cells.Clear  '全てクリア

For i = 1 To 10
  For j = 1 To 10
    Cells(i, j).Value = i + j
  Next j
Next i

Range(Cells(2, 2), Cells(5, 5)).Select
var1 = Selection  'これで選択範囲を格納できるらしい

Stop  'ここで、手動で離れた複数のセル範囲を選択してみる

var1 = Selection   'これは最初に選択した範囲のみが格納されているようだ
Stop

Dim range1 As Range
Dim range2 As Range
Dim unionRange As Range

Set range1 = Range(Cells(1, 1), Cells(3, 3))
var1 = range1.Value  'range1の範囲が格納されている
Stop

Set range2 = Range(Cells(5, 5), Cells(7, 7))
Set unionRange = Union(range1, range2)  '2つのRangeを結合する
unionRange.Interior.ColorIndex = 5  '背景色を青に

var1 = unionRange  'これはrange1の部分しか格納されていないようだ
Stop

End Sub


'結合セルがある範囲をVariantへ格納
Sub ddd()

Dim var1 As Variant
Dim i As Long
Dim j As Long

Application.DisplayAlerts = False
Cells.Clear  '全てクリア

For i = 1 To 10
  For j = 1 To 10
    Cells(i, j).Value = i + j
  Next j
Next i

var1 = Range(Cells(1, 1), Cells(1, 2))
Debug.Print VarType(var1(1, 1))   '5   Double型
Debug.Print VarType(var1(1, 2))   '5   Double型

Range(Cells(1, 1), Cells(1, 2)).Merge   '2つのセルを結合
var1 = Range(Cells(1, 1), Cells(1, 2))
Debug.Print VarType(var1(1, 1))   '5   Double型
Debug.Print VarType(var1(1, 2))   '0   Empty値になる
'結合したセル範囲をVariantに格納すると、左上のセル以外はEmptyになるので注意

Debug.Print var1(1, 2) = ""  'True  Emptyなので空文字と一致すると判定される
Debug.Print var1(1, 2) = 0   'True  Emptyなので0と一致すると判定される

Debug.Print "-----------------------"

var1 = Range(Cells(3, 3), Cells(6, 6))
Debug.Print UBound(var1, 1)  '4   1次元目の要素数

Range(Cells(3, 3), Cells(6, 6)).Merge
var1 = Range(Cells(3, 3), Cells(6, 6))
Debug.Print UBound(var1, 1)  '4    結合していても、配列の要素数が変わるわけではない

End Sub


'セル範囲をVariantに格納する方法と、1セルずつ取得する方法の速度差の測定
Sub eee()

Dim startTime As Double
Dim endTime As Double
Dim total As Long
Dim i As Long
Dim j As Long

Application.ScreenUpdating = False

Cells.Clear  '全てクリア

For i = 1 To 1000
  For j = 1 To 1000
    Cells(i, j).Value = i + j
  Next j
Next i

Dim range1 As Range
Dim var1 As Variant

startTime = Timer
total = 0

'Variant変数に代入し、配列を走査して処理
Set range1 = Range(Cells(1, 1), Cells(1000, 1000))
var1 = range1.Value 'var1にrange1の範囲のセルの値を全て格納

For i = LBound(var1) To UBound(var1)
  For j = 1 To 1000
    If var1(i, j) Mod 3 = 0 Then
      total = total + var1(i, j)
    End If
  Next j
Next i

endTime = Timer

Debug.Print total  '  333666000
Debug.Print endTime - startTime  ' 0.296875


startTime = Timer
total = 0

'セルを1つずつ参照して処理
For i = 1 To 1000
  For j = 1 To 1000
    If Cells(i, j).Value Mod 3 = 0 Then
      total = total + Cells(i, j).Value
    End If
  Next j
Next i

endTime = Timer

Debug.Print total  '  333666000
Debug.Print endTime - startTime  ' 3.921875

'Variant変数に代入するほうが、セルを参照する方法よりも10倍以上速い。範囲が広がるほど差がつくらしい

End Sub

セルの書式を日付・時刻型にする

Sub bbbb()

'日付
Cells(20, 1).NumberFormatLocal = "m""月""d""日"""
' ユーザー定義の m"月"d"日" 形式にする

Debug.Print Cells(20, 1).NumberFormatLocal = "m""月""d""日"""  'True
Debug.Print VarType(Cells(20, 1).NumberFormatLocal)  '8  文字列型　　NumberFormatLocalは文字列になるらしい

Cells(20, 1).NumberFormatLocal = "yyyy/m/d;@"                  '日付の　2012/3/14
Cells(20, 1).NumberFormatLocal = "yyyy/m/d"                    '日付の　*2012/3/14
Cells(20, 1).NumberFormatLocal = "yyyy""年""m""月""d""日"";@"  '日付の　2012年3月14日
Cells(20, 1).NumberFormatLocal = "yyyy/m/d h:mm;@"             '日付の　2012/3/14 13:00

Debug.Print Cells(20, 1).Value           '2021/01/02
Debug.Print VarType(Cells(20, 1).Value)  '7  日付型
Debug.Print CStr(Cells(20, 1).Value)     '2021/01/02   このまま文字列にすることは可能

'時刻
Cells(21, 1).NumberFormatLocal = "[$-F400]h:mm:ss AM/PM"    '時刻の  *13:30:55
Cells(21, 1).NumberFormatLocal = "h:mm:ss;@"                '時刻の  13:30:55
Cells(21, 1).NumberFormatLocal = "[$-409]h:mm:ss AM/PM;@"   '時刻の  1:30:55 PM
Cells(21, 1).NumberFormatLocal = "h""時""mm""分""ss""秒"""  'ユーザー定義の  h"時"mm"分"ss"秒"

Debug.Print Cells(21, 1).Value           '0.580497685185185
Debug.Print VarType(Cells(21, 1).Value)  '5   Double型
Debug.Print CStr(Cells(21, 1).Value)     '0.580497685185185   これは小数値の文字列になってしまう
Debug.Print CStr(CDate(Cells(21, 1).Value))  '13:55:55  こうすれば文字列として取得できる

End Sub

セルの値が日付・時刻形式であるかを判断し、文字列データ(2012/5/15 等)へ変換する

時刻は判定が難しい。フォーマットを限定するしかないか

Sub cccc()

Dim dateStr As String  '日付形式(2011/15/21)の文字列
Dim yearStr As String  '年(Year)の文字列
Dim monthStr As String '月(Month)の文字列
Dim dayStr As String   '日(Day)の文字列
Dim timeStr As String  '時刻形式(12:13:14)の文字列
Dim hourStr As String  '時(Hour)の文字列
Dim minStr As String   '分(Minute)の文字列
Dim secStr As String   '秒(Second)の文字列

'Cells(1, 1)は日付型の書式で、表示は2010/10/15

'日付型のセルのValueは、Vartypeで全て7の日付型と判定されるらしい
'2020/12/14 14:55 のように、時刻部分が入っていても日付部分があれば日付型と判定されるようだ
If VarType(Cells(1, 1).Value) = 7 Then
  dateStr = Cells(1, 1).Value          'これはそのまま文字列になるらしい
  yearStr = Year(Cells(1, 1).Value)    '年を取得。これも文字列
  monthStr = Month(Cells(1, 1).Value)  '月
  dayStr = Day(Cells(1, 1).Value)      '日
  Debug.Print dateStr  '2010/10/15
  Debug.Print yearStr  '2010
  Debug.Print monthStr '10
  Debug.Print dayStr   '15
End If

Debug.Print "------------------------------"

'Cells(2, 1)は日付型の書式で、表示は2001/1/2
If VarType(Cells(2, 1).Value) = 7 Then
  dateStr = Cells(2, 1).Value
  yearStr = Year(Cells(2, 1).Value)
  monthStr = Month(Cells(2, 1).Value)
  dayStr = Day(Cells(2, 1).Value)
  Debug.Print dateStr  '2001/01/02
  Debug.Print yearStr  '2001
  Debug.Print monthStr '1
  Debug.Print dayStr   '2
End If

Debug.Print "------------------------------"

'Cells(3, 1)は日付型の書式で、表示は2020/1/2 15:18   ※時刻は15:18:19まで入っている
If VarType(Cells(3, 1).Value) = 7 Then
  dateStr = Cells(3, 1).Value
  yearStr = Year(Cells(3, 1).Value)
  monthStr = Month(Cells(3, 1).Value)
  dayStr = Day(Cells(3, 1).Value)
  hourStr = Hour(Cells(3, 1).Value)  '時
  minStr = Minute(Cells(3, 1).Value) '分
  secStr = Second(Cells(3, 1).Value) '秒
  Debug.Print dateStr  '2020/01/02 15:18:19
  Debug.Print yearStr  '2001
  Debug.Print monthStr '1
  Debug.Print dayStr   '2
  Debug.Print hourStr  '15
  Debug.Print minStr   '18
  Debug.Print secStr   '19
End If


Debug.Print "------------------------------"

Debug.Print isTimeData(Cells(1, 2).Value, Cells(1, 2).NumberFormatLocal)  'True
'時刻型のデータであるかを判定する関数を呼び出し。このセルは時刻型の書式で、表示は12:14:15

If isTimeData(Cells(1, 2).Value, Cells(1, 2).NumberFormatLocal) Then
  timeStr = CStr(CDate(Cells(1, 2).Value))   'これでDoubleの値から時刻形式の文字列へ
  hourStr = Hour(Cells(1, 2).Value)   '時　　これはそのまま文字列らしい
  minStr = Minute(Cells(1, 2).Value)  '分
  secStr = Second(Cells(1, 2).Value)  '秒
  Debug.Print timeStr  '12:14:15
  Debug.Print hourStr  '12
  Debug.Print minStr   '14
  Debug.Print secStr   '15
End If

Debug.Print "------------------------------"

'Cells(2,2)は時刻型で、表示は1:01:02
If isTimeData(Cells(2, 2).Value, Cells(2, 2).NumberFormatLocal) Then
  timeStr = CStr(CDate(Cells(2, 2).Value))
  hourStr = Hour(Cells(2, 2).Value)
  minStr = Minute(Cells(2, 2).Value)
  secStr = Second(Cells(2, 2).Value)
  Debug.Print timeStr  '1:01:02
  Debug.Print hourStr  '1
  Debug.Print minStr   '1
  Debug.Print secStr   '2
End If


End Sub


Function isTimeData(ByVal xValue As Variant, ByVal formatStr As String) As Boolean
'時刻型のデータであるかを判定。セルのValueはVariant型なので、引数もVariantで

  isTimeData = False
  
  If VarType(xValue) = 5 Then   '時刻型のセルのValueはDouble型なので、まずそれを判定
  
    'セルのNumberFormatLocalが以下のどれかに当てはまれば、時刻型と判断する
    '時刻型のフォーマットはこれだけではないが、一応代表的なもので
    If formatStr = "[$-F400]h:mm:ss AM/PM" Or _
      formatStr = "h:mm:ss" Or _
      formatStr = "h:mm:ss;@" Or _
      formatStr = "[$-409]h:mm:ss AM/PM;@" Or _
      formatStr = "h:mm:ss AM/PM" Then
      isTimeData = True
    End If
  End If
  
  '※2020/12/15 15:05  のように、日付と時刻が両方入っているセルはVartypeで7の日付型と判定されるようだ

End Function

セルの書式を通貨型にすると、VBA内では、小数部は4桁目までの四捨五入丸めになってしまうらしい

0.123456 → 0.1235 になる　　セルの表示は4桁目以降も出ているし、値も同じだが、VBA内での扱いが違うか

Sub nnnn()

Cells.Clear
Cells(1, 1).NumberFormatLocal = "\#,##0.000000;\-#,##0.000000"
'セルの書式を通貨型にする 小数部分は6桁

Cells(1, 1).Value = 0.123456789
Debug.Print Cells(1, 1).Value   '0.1235
'セルの書式を通貨型にすると、小数部は4桁目までの四捨五入丸めになってしまうらしい

Debug.Print Cells(1, 1).Value = 0.1235   'True


Cells(1, 1).Value = 0.1
Debug.Print Cells(1, 1).Value   '0.1
Cells(1, 1).Value = 0.12
Debug.Print Cells(1, 1).Value   '0.12
Cells(1, 1).Value = 0.123
Debug.Print Cells(1, 1).Value   '0.123
Cells(1, 1).Value = 0.1234
Debug.Print Cells(1, 1).Value   '0.1234
Cells(1, 1).Value = 0.12345
Debug.Print Cells(1, 1).Value   '0.1235


Debug.Print VarType(Cells(1, 1))   '6  通貨型　　Doubleとは判定されないらしい。これで判断すべきか
End Sub

セルの値を取得する　.Value、.Value2、.Text .Textは列幅によってセルの表示が変化すると、それに合わせた取得値になるので、安定しない

Cells(1, 1).NumberFormatLocal = "yyyy/m/d;@"  'セルの書式を日付に
Cells(1, 1).Value = "2021/12/15"   'セルの表示は2021/12/15になっている

Debug.Print Cells(1, 1).Value   ' 2021/12/15    バリアント型(Variant)の値を取得するらしい
Debug.Print Cells(1, 1).Value2  ' 44545         バリアント型(Variant)の値を取得するらしい
Debug.Print Cells(1, 1).Text    ' 2021/12/15    文字列型(String)の値を取得するらしい

'Value2は、通貨型(Currency)や日付型(Date)のデータ型を取得･設定しないらしい

Debug.Print VarType(Cells(1, 1).Value)    '日付型
Debug.Print VarType(Cells(1, 1).Value2)   'Double型
Debug.Print VarType(Cells(1, 1).Text)     '文字列型

'.Textは、セルの表示が変化すると.Textもそれにあわせて変化することに注意
Columns(1).ColumnWidth = 30
Debug.Print Cells(1, 1).Text   '2021/12/15
Columns(1).ColumnWidth = 3
Debug.Print Cells(1, 1).Text   '##   セル幅が狭くなって表示が「##」になったことで、.Textも変化する
Columns(1).ColumnWidth = 20

Debug.Print CStr(Cells(1, 1).Value)     '2021/12/15   このまま文字列にすることは可能

Cells(1, 1).NumberFormatLocal = "h:mm:ss;@"   '時刻型の書式に
Cells(1, 1).Value = "12:14:26"
Debug.Print Cells(1, 1).Value               '0.510023148148148   時刻型は浮動小数になってしまう
Debug.Print CStr(CDate(Cells(1, 1).Value))  '12:14:26    こうすれば時刻の文字列として取得できる


'日付形式のセルの値の取得確認
Cells(1, 1).NumberFormatLocal = "yyyy/m/d"
Cells(1, 1).Value = "2019/05/12"
Debug.Print Cells(1, 1).Value     '2019/05/12  セルの表示は2019/5/12で、月の桁数が違う

Cells(1, 1).NumberFormatLocal = "yyyy/m"
Cells(1, 1).Value = "2019/05/12"
Debug.Print Cells(1, 1).Value     '2019/05/12　セルの表示は2019/5で、月の桁数と日付が入ることが違う

Cells(1, 1).NumberFormatLocal = "yyyy""年""m""月""d""日"";@"
Debug.Print Cells(1, 1).Value     '2019/05/12   セルの表示は2019年5月12日

Cells(1, 1).NumberFormatLocal = "yyyy/m/d h:mm;@"
Cells(1, 1).Value = "2019/05/12 12:58"
Debug.Print Cells(1, 1).Value
'2019/05/12 12:58:00     セルの表示は2019/05/12 12:58だが、秒まで入ってしまう


'ユーザー定義のセルの値の取得確認
Cells(1, 1).NumberFormatLocal = "000.00"
Cells(1, 1).Value = 12
Debug.Print Cells(1, 1).Value     '12  セルの表示は012.00

'.Value では、セルの表示のままの値を取得できるとは限らないことに注意

行高の取得・設定と、列幅の取得・設定 かなりわかりにくいので注意

'行高を取得
Debug.Print Rows(3).Height  '3行目の行高を取得
Debug.Print Cells(5, 3).EntireRow.Height  '5行目の行高を取得

Debug.Print Range(Cells(1, 3), Cells(5, 5)).EntireRow.Height
'これは1～5行の行高の合計になる


'行高の設定
Rows(2).RowHeight = 54
Cells(3, 3).EntireRow.RowHeight = 100
Range(Cells(1, 3), Cells(5, 5)).EntireRow.RowHeight = 20    'これは1～5行を全て20に

Rows(2).AutoFit   '行高の自動調整


'列幅の取得
Debug.Print Columns(3).ColumnWidth  'これは通常の列幅。これを使うだろう
Debug.Print Columns(3).Width        'これはポイント単位で取得。あまり使わない
Debug.Print Cells(5, 4).EntireColumn.ColumnWidth  '4列目の列幅

Debug.Print Range(Cells(1, 1), Cells(5, 5)).EntireColumn.ColumnWidth
'これはなぜか1列目のみの列幅になる
Debug.Print Range(Columns(2), Columns(3)).EntireColumn.ColumnWidth
'これも2列目のみ


'列幅の設定
Columns(3).ColumnWidth = 20
Range(Cells(1, 1), Cells(5, 5)).EntireColumn.ColumnWidth = 25
'これは1～5列目が25になる。取得の時と違うらしい
Range(Columns(2), Columns(3)).EntireColumn.ColumnWidth = 10
'これは2～3列目が10になる。

2つのセル範囲の重なっている部分をRangeとして取得する　Intersect

Dim range1 As Range
Dim range2 As Range
Dim range3 As Range

Set range1 = Range(Cells(1, 1), Cells(3, 3))
Set range2 = Range(Cells(2, 2), Cells(5, 5))

Set range3 = Intersect(range1, range2)  'range1とrange2の重なっている範囲を取得

Debug.Print range3.Rows.Count     '行数
Debug.Print range3.Columns.Count  '列数
Debug.Print range3(1).Value       '左上のセルの値


'選択範囲の判定に使う
Columns(2).Select
Set range1 = Intersect(Selection, Columns(3))

If range1 Is Nothing Then
  Debug.Print "列3と共通部分無し"  '今回の結果はこちら
Else
  Debug.Print "列3と共通部分あり"
End If

Range(Cells(2, 2), Cells(4, 4)).Select
Set range1 = Intersect(Selection, Columns(3))

If range1 Is Nothing Then
  Debug.Print "列3と共通部分無し"
Else
  Debug.Print "列3と共通部分あり"  '今回の結果はこちら
End If