忍者ブログ
  • 2025.05《
  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 7
  • 8
  • 9
  • 10
  • 11
  • 12
  • 13
  • 14
  • 15
  • 16
  • 17
  • 18
  • 19
  • 20
  • 21
  • 22
  • 23
  • 24
  • 25
  • 26
  • 27
  • 28
  • 29
  • 30
  • 》 2025.07
[PR]
×

[PR]上記の広告は3ヶ月以上新規記事投稿のないブログに表示されています。新しい記事を書く事で広告が消えます。

2025/06/19 22:09 |
Cells
Excelマクロのモジュールをそのまま貼り付け。
(会社とか家とか出先とかで見るため)
「Option Compare Binary」以下を標準モジュールに貼り付ければ、Myマクロ辞典に!
貼り付け後、「■Sub 」を「Sub 」に置き換えよう!
※公開している以上、利用は自由ですが、自己責任で。


Option Compare Binary
Option Explicit
'
'セル関連マクロ
Private a As Variant

■Sub 書式設定()

'→Text の データ型の変換 参照

End Sub

■Sub セルの指定()

ActiveCell.Interior.ColorIndex = 2 '現在のアクティブセルの色を変更

ActiveCell.Offset(4, 2).Activate 'アクティブセルの下4つ、右2つ先のセルを選択

Range("セルの名前").Select '名前をつけたセルを指定(A1セルに「セルの名前」と名前をつけている)
Cells(2, 6).Activate
'★Selectは「選択」ですので、複数の選択もあり得ます。
'★Activateは「アクティブ」で一つだけです。

Range(Cells(2, 6)).Activate '×
Range(Cells(2, 6), Cells(2, 7)).Activate '○

'指定したいセルがあるワークシートがアクティブでない場合は、まずワークシートをアクティブにする。
Workbooks("OSリスト_2009.xls").Worksheets("貼り付けシート").Range("A1").Select '×…実行時エラーになる

Workbooks("OSリスト_2010.xls").Worksheets("貼り付けシート").Activate '○
Range("B2").Select

'離れたセルを同時に指定
Range("A1,C4").Select 'A1とC4が選択される

'参考
'http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_cell.html#resize

End Sub

■Sub セル範囲の指定()

Range("A1:D5").Select 'セルA1からD5を選択
Range("A1,D5").Select 'セルA1とD5を選択(独立した複数のセル)
Range("A1:D5,E7:J10").Select 'セルA1からD5とE7からJ10を選択(独立した複数のセル範囲)

'Range型の変数を指定することも可能。
Dim Rng As Range
Set Rng = Range("J10")
Range(Range("A1"), Rng).Select

'Cells型で指定
Range(Cells(1, 5), Cells(2, 6)).Activate

'Offset型で指定
Range(Cells(5, 5), Cells(5, 5).Offset(-4, -2)).Activate '上4、左2まで範囲指定

'Resize型で指定(Rangeオブジェクト.Resize(変更後の行数, 変更後の列数))
Range("B2").Resize(2, 3).Select '下2、右3
Range("B2").Resize(-2, -3).Select '×(セルが存在しない)
Range("B2").Resize(2, 3).Activate '×(範囲指定にActivateは使えない)

End Sub

■Sub セル番地をオブジェクト変数に導入()

Dim MySell As Range
Set MySell = Range("A1")
MsgBox "MySellの中身は " & MySell '.Value(省略可)

Dim n As String
n = MySell
MsgBox "n= " & n

MySell = "ABC"

MySell = n

'MySellがファイル名等の場合
Workbooks(MySell.Value).Activate '.Value(省略不可)

End Sub

■Sub セル番地を取得()

MsgBox ActiveCell.Address
'答えは「A1」

End Sub

■Sub セルの書式を取得1()

Dim a As Long, b As Long

a = Range("A1").NumberFormatLocal '表示形式
b = Range("A1").Interior.ColorIndex '背景色

MsgBox a & vbNewLine & b

End Sub

■Sub セルの書式を取得2()

Dim a As Long, b As Long

'a = Range("A1").Font.ColorIndex '文字色

'a = Range("A1").Font.Strikethrough '取消線(True:-1, False:0)
'b = Range("b1").Font.Strikethrough '取消線(True:-1, False:0)

a = Range("A1").Font.Underline
b = Range("b1").Font.Underline

MsgBox a & vbNewLine & b

End Sub

■Sub セルの書式を取得3()

If Range("B1").Font.Strikethrough = True Then MsgBox "true" Else MsgBox "false" '取消線があるか?

If Range("A1").Font.Underline <> xlNone Then MsgBox "true" Else MsgBox "false" '下線があるか?

End Sub

■Sub 値を代入()

'コピー先=コピー元
'Cells(行番号/縦/Rows, 列番号/横/Columns)
'Cells(行番号(縦), 列番号(横))、Range(セル)、Range(開始セル,終了セル)

'Rangeプロパティ Range("C4")
'Cellsプロパティ Cells(4, 3) Cells(Rows, Columns)


Cells(5, 1).Value = 100
Range("B1").Value = "B1"
Range("C1", "D2").Value = "あいうえお"
Range("M1:M10").Value = "かきくけこ"
Range(Cells(1, 5), Cells(2, 6)).Value = "E1F2"

End Sub

■Sub 数式代入()

'複数のセルに代入
Range("A1:C1").Select
Selection.FormulaR1C1 = "=R[4]C[1]"

Range("H2:H20") = "=CONCATENATE(RC[1],RC[2])" 'H2:H20にI列とJ列をつなげた文字列をセット

Range("k1:k10").Select
Selection.FormulaR1C1 = "=IF(ISBLANK(R[0]C[1])=TRUE,9,INDEX(担当班!c1,MATCH(R[0]C[1],担当班!c2,0),0))"

'R[1]C ひとつ下のセル A1→A2
'RC[1] ひとつ右のセル A1→B1


'行の場合は下側に動くのがプラス(+)、上側に動くのがマイナス(-)
'列の場合は右側に動くのがプラス(+)、左側に動くのがマイナス(-)

End Sub

■Sub 関数導入()

Dim zz As String
zz = 583
Cells(584, 1) = "=Count(a4:a" & zz & ")"

'---
'複数セルへの数式の貼り付け

Range("k1:k10").Select
Selection.FormulaR1C1 = "=IF(ISBLANK(R[0]C[1])=TRUE,9,INDEX(担当班コード!c1,MATCH(R[0]C[1],担当班コード!c2,0),0))"

'=R[4]C[1]"

'Range(Cells(1, 11)).Value = _
"=IF(ISBLANK(" & .Offset(0, 0).Value & ")=TRUE,9,INDEX(担当班コード!$A:$A,MATCH(" & .Offset(0, 0).Value & ",担当班コード!$B:$B,0),0))"

'---
'オブジェクト型変数を利用
mySH.Range("D12").Value = Application.VLookup(mySH.Range("B12"), Range("brand"), 2, False)
'× fcSH.Cells(i, 5).Value = WorksheetFunction.Lookup(fcSH.Range(Cells(i, 1)), Range("SLCコード"))


End Sub

■Sub 関数をマクロに利用()

'Text> ワークシート関数 参照

End Sub

■Sub 日付を検索()
'日付の検索は難しい。
'特に数式(=C4+1とか)で入力されている日付は Find では見つけられないので、For Each を使う。

Dim cv As Variant
Dim c As Variant
Dim d As String
Dim search_words As Date

search_words = "2013/5/21"

cv = ActiveSheet.UsedRange 'すべてのセル?

For Each c In cv 'Rangeを指定してもよい/ex:Range("C5:HX5")
If c Like search_words Then
d = c.Address '該当するセル番地を取得
End If
Next c

MsgBox d

End Sub

■Sub 日付計算()

Dim StrAddA As String, StrAddB As String, StrAddC As String

StrAddA = DateAdd("d", 40, "2009/1/16")
StrAddB = DateAdd("ww", -2, "2009/1/16")
StrAddC = DateAdd("n", 75, "1:15:20")

MsgBox StrAddA & vbCrLf & StrAddB & vbCrLf & StrAddC

'■加算対象に指定する文字列
'yyyy 年
'q 四半期
'm 月
'y 年間通算日
'd 日
'w 週日
'ww 週
'h 時
'n 分
's 秒

End Sub

■Sub 値_日付_を取得()

Dim d As String
d = Format(Workbooks("OSリスト_2009.xls").Worksheets("マニュアル").Range("B2"), "YYYYMMDD")

MsgBox Workbooks("Book1.xls").Worksheets("Sheet1").Range("C3")

'今日の日付を取得
d = Date
'MsgBox Format(Date, "YYYYMMDD")

End Sub

■Sub 日付かどうか確認()

MsgBox IsDate("2001,1,1")
'日付データならTrue を返す

End Sub

■Sub 値のタイプ判定1()

a = "ABC"
MsgBox VarType(a) '8を表示
a = 123
MsgBox VarType(a) '2を表示
a = 54.67
MsgBox VarType(a) '5を表示


'◆返り値一覧 VarType(varname)
'定数 値 内容
'vbEmpty 0 Empty値
'vbNull 1 Null値
'vbInteger 2 整数型
'vbLong 3 長整数型
'vbSingle 4 単精度浮動小数点数型
'vbDouble 5 倍精度浮動小数点数型
'vbCurrency 6 通貨型
'vbDate 7 日付型
'vbString 8 文字列型
'vbObject 9 オブジェクト
'vbError 10 エラー値
'vbBoolean 11 ブール型
'vbVariant 12 バリアント型(バリアント型配列にのみ使用)
'vbDataObject 13 非OLEオートメーションオブジェクト
'vbDecimal 14 10進数型
'vbByte 17 バイト型
'vbArray 8192 配列

End Sub

■Sub 値のタイプ判定2()
'数字(全角含む)か文字か

a = IsNumeric(100)
MsgBox a

a = IsNumeric("100")
MsgBox a

a = IsNumeric("あいう")
MsgBox a

a = IsNumeric("-")
MsgBox a

End Sub

■Sub 空欄チェック()

If IsEmpty(Range("Q17")) = True Then MsgBox "空です。"

If Application.WorksheetFunction.ISBLANK(Range("Q17").Value) = True Then MsgBox "空です。"

End Sub

■Sub 値を削除()

Cells(2, 3).ClearContents

セル名または範囲.Clear '書式、値、全てクリアする
セル名または範囲.ClearContents '値のみをクリアする
セル名または範囲.ClearFormats '書式をクリアする
セル名または範囲.ClearOutline 'アウトラインをクリアする

End Sub

■Sub 行列幅の調整()

'自動調整
Columns("A:C").AutoFit
Rows("1:10").AutoFit

Range("A3").Columns.AutoFit '---セルA3を自動調整したセル幅に揃える
Range("A3").EntireColumn.AutoFit '---A列の一番長いセルのセル幅に自動調整
Range("A3:C14").Columns.AutoFit '---セル範囲A3:C14の一番長いセルのセル幅に自動調整

'数値を指定
Rows("4:5").RowHeight = 30
Columns("F:G").ColumnWidth = 30

'標準の行の高さに戻す
Rows("4:5").UseStandardHeight = True
Columns("F:G").UseStandardWidth = True

End Sub

■Sub 行列番号の所得()

Debug.Print "現在選択中のセルの行番号 = " & ActiveCell.Row
Debug.Print "現在選択中のセルの列番号 = " & ActiveCell.Column

Debug.Print "指定したセルの行番号 = " & Range("C5").Row
Debug.Print "指定したセルの列番号 = " & Range("C5").Column

End Sub

■Sub 行列指定()

Dim a As Variant, b As Variant

a = 10
b = 12

Rows("1:" & a).Select '行1~10を選択
Range(Columns(a), Columns(b)).Select '列10~12を選択

'Rangeオブジェクトを指定して行全体を選択
Range("A2:A4").EntireRow.Select '2~4行目を指定
Range("B2,D2,G10").EntireColumn.Select '2列目と4列目、7列目を指定(離れた領域)

End Sub

■Sub セルコピー()

'行コピー
Rows("1:10").Copy
Rows("12").PasteSpecial '貼り付けその1
ActiveSheet.Paste Destination:=Rows(12) '貼り付けその2(行番号は""なしでも指定可)

'列コピー
Columns("A:N").Copy
Columns("P").PasteSpecial '貼り付けその1
Columns(16).PasteSpecial '貼り付けその2(列番号は数字なら""なしでも指定可)

'※元のセル(行/列)は空で残る
Range("A1:B7").Copy Destination:=Range("A10") 'セルA1:B7の内容をA10のセルにコピー
Range("A1:B7").Copy Worksheets("Sheet2").Range("A1") '他のワークシートにコピー

'※Destinationは省略可

'※元のセル(行/列)はそのまま残る
Range("1:2").Copy '1~2行目をコピー
Range("4").Insert 'コピーした行を4行目に挿入(1:2は詰められる)

End Sub

■Sub セルの値コピー()

'同シート
Range(Cells(1, 1), Cells(2, 2)).Value = Range("A1:B2").Value '値コピー(数式の削除)

'別シート
Workbooks(myFile).Worksheets("Sheet1").Range("D2").Value = Workbooks(myFile).Worksheets("Sheet2").Range("A2").Value

End Sub

■Sub セルのコピー_形式を指定()

Worksheets("SSS").Activate 'ワークシートをアクティブにする
Range("A1:C3").Copy 'コピーする

Range("A4").PasteSpecial Paste:=xlAll 'すべて貼り付け
Range("A4").PasteSpecial Paste:=xlValues '値を貼り付け
Range("A4").PasteSpecial Paste:=xlFormulas '数式を貼り付け
Range("A4").PasteSpecial Paste:=xlFormats '書式だけ貼り付け
Range("A4").PasteSpecial Paste:=xlNotes 'メモ貼り付け
Range("A4").PasteSpecial Paste:=xlAllExceptBorders '罫線を除くすべて貼り付け

Workbooks("OSリスト_2009.xls").Worksheets("貼り付けシート").Activate
Range("A1").PasteSpecial Paste:=xlPasteValues '値コピー
'Range("A1").Select
'ActiveSheet.PasteSpecial Paste:=xlPasteValues

'コピーモードを解除しないと次の作業がうまくいかない場合がある。
Application.CutCopyMode = False

End Sub

■Sub セルのコピー_オートフィル()

'オートフィルで連続データを作成
Range("A1").Value = "1"
Range("A1").AutoFill Range("A1:A10"), xlFillSeries

End Sub

■Sub セルのコピー_全セル()

Cells.Copy
Worksheets("Sheet2").Paste

Cells.Copy Worksheets("Sheet10").Range("A1")

End Sub

■Sub セルのコピー_新しいシート()

Rows("1:5").Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste

Range("B1").Select

'Pasteメゾットをセル指定なしで行うと領域指定が外れなくなるので、任意をセルをSelectしてはずす(Activateでははずれない)

End Sub

■Sub セルのコピー_応用()
'複数セルのコピー (変数利用、Rangeとcells使用、シート間)

'RangeプロパティとCellsプロパティの両方が同じシートを指す必要がある
'実行時は、コピー元のシート(この場合COPYAのシート)がActivateになっていること。

Dim COPYA As Worksheet 'コピー元のシート
Dim PASTEB As Worksheet 'ペーストするシート
Dim F As Variant

'---シート名を変数に
Set COPYA = Worksheets("元データ")
Set PASTEB = Worksheets("コピー先")

'---最下行検出
PASTEB.Activate
F = Range("A1").End(xlDown).Row
Debug.Print F

'---データコピー(Cells(行, 列)
PASTEB.Range(PASTEB.Cells(14, 2), PASTEB.Cells(F, 2)).Value = COPYA.Range(COPYA.Cells(2, 4), COPYA.Cells(F, 4)).Value

End Sub

■Sub セルの挿入()

'行列の挿入 参照↓

End Sub

■Sub セルの移動_値、書式()
'セルの中身(値、書式など)の移動

'※元のセル(行/列)は空で残る
Range("A1:B7").Cut Destination:=Range("A10") 'セルA1:B7の内容をA10のセルに移動
Range("A1:B7").Cut Destination:=Worksheets("Sheet2").Range("A1") '他のワークシートに移動

Rows("1:2").Cut Destination:=Rows("11:12") '行指定
Columns("1:2").Cut Destination:=Columns("11:12") '列指定

Range("2:2").Cut Destination:=Range("3:3") 'RangeでもOK
Range("A:B").Cut Destination:=Range("D:E")


'※Destinationは省略可
Range("A1:B7").Cut Range("A10")


'変数も使える
Dim a As Variant
Dim b As Variant

a = 1
b = 2

Rows(a & ":" & b).Cut Destination:=Rows("11:12")


'※元のセル(行/列)は残らない
Range("1:2").Cut
Range("4").Insert '1:2行目は詰められる


'※セルの移動_Offset も参照↓

End Sub

■Sub セルの移動_Offset()
'Offset(行方向、列方向)

ActiveCell.Offset(1, 0).Select '行方向に1、つまり1つ下のセルを選択
Range("E8").Offset(-4, -2).Activate 'E8→C4(上に4つ、左に2つ)移動。
Range("E8").Offset(0, 0).Activate 'E8をアクティブに。

'行の場合は下側に動くのがプラス(+)、上側に動くのがマイナス(-)
'列の場合は右側に動くのがプラス(+)、左側に動くのがマイナス(-)
'参照:http://www.moug.net/tech/exvba/0050057.htm

'Resize はセル範囲指定

End Sub

■Sub セルの移動_ホームポジション()

ActiveWindow.ScrollColumn = 10 'スクロール列の設定
ActiveWindow.ScrollRow = 3 'スクロール行の設定

End Sub

■Sub シート間の行列コピー()

'同じブック内で行コピー、sheet1→sheet2
Workbooks("マクロ.xls").Activate
Worksheets("sheet1").Rows("1:1").Copy Destination:=Worksheets("sheet2").Rows("1:1")
Worksheets("sheet1").Columns("A:A").Copy Destination:=Worksheets("sheet2").Columns("A:A")

'Range指定でもOK
'Worksheets("sheet1").Range("1:1").Copy Destination:=Worksheets("sheet2").Range("1:1")

End Sub

■Sub ブック間の行列コピー()

'コピー
Workbooks("事業_連絡票作成マクロv3.xls").Activate
Worksheets("インポートフォーム").Rows("1:1").Copy 'Columns("A:A").Copy

'貼り付け
Workbooks("マクロ.xls").Activate
Worksheets("sheet2").Rows("1:1").PasteSpecial

'Range指定でもOK

End Sub

■Sub 行列の挿入()

Rows("4:5").Insert '行番号(範囲)で指定
Range("B2").EntireRow.Insert 'セルで指定

Columns(2).Insert '列番号で指定
Range("D1").EntireColumn.Insert 'セルで指定

'行列全体ではなく範囲で指定
Range("A2:C5").Insert Shift:=xlShiftDown

'B7セルを基準に右方向の終端(≠最終セル)までを選択してセルを挿入(既存のセルを下方向に移動)後、左または上のセルの「書式」をコピー
Range("B7", Range("B7").End(xlToRight)).Insert Shift:=xlShiftDown, Copyorigin:=xlFormatFromLeftOrAbove

'※Shift値(省略すると右方向にシフト)
' xlShiftToRight セルを挿入後、右方向にシフト
' xlShiftDown セルを挿入後、下方向にシフト

'※CopyOriginの値
' xlFormatFromLeftOrAbove 左または上と同じ書式を適用
' xlFormatFromRightOrBelow 右または下と同じ書式を適用

End Sub

■Sub 行列の削除()

Columns("4:6").Delete

Rows("1:3").Delete Shift:=xlShiftUp

Range("E3", Range("E3").End(xlDown)).Delete Shift:=xlShiftUp

'※Shift値(省略すると左/上方向にシフト)
' xlShiftToLeft セルを左方向にシフト
' xlShiftUp セルを上方向にシフト

End Sub

■Sub 行列の表示非表示判定()
'アウトライン等で表示になる行(列)のセルに対して、表示状態を返す。

If ActiveCell.EntireRow.Hidden = True Then MsgBox "行が非表示" Else MsgBox "行は全表示" 'アクティブセルがひょうじされているかどうか
If Range("H1").EntireColumn.Hidden = True Then MsgBox "列が非表示" Else MsgBox "列は全表示" 'セルH5が表示されているかどうか

End Sub

■Sub アウトライン判定()

MsgBox Columns(10).Summary '「True」を返す。 …列10(J)にアウトラインの[+]マークがある
MsgBox Columns(11).Summary '「false」を返す。…列11(K)にアウトラインの[+]マークはない

End Sub

■Sub 行列の再表示()

Cells.EntireColumn.Hidden = False '列の再表示(全セル対象)
'Cells.EntireRow.Hidden = False '行の再表示(全セル対象)

End Sub

■Sub 最終行と最終列を検出1()

'◆上(左)から最終行(列)を取得
a = Range("A1").End(xlToRight).Column '「列番号」を返す
b = Range("A1").End(xlDown).Row '「行番号」を返す
c = Range("A1").End(xlToRight) '右端の「セルの値」を返す
Debug.Print c

xdown = Range(Cells(1, 3), Cells(1, 3)).End(xlDown).Row '下端検出


'◆「Cells.」にすると、1行目またはA列の最終行を取得する
Cells.End(xlDown).Row
Cells.End(xlToRight).Column


'◆下(右)から最終行(列)を取得
a = Cells(Rows.Count, 1).End(xlUp).Row '最下セルから下端を取得
b = Cells(1, Columns.Count).End(xlToLeft).Column '最右セルから右端を取得

'定数 方向 メモ
'xlDown 下方向 Toがない
'xlToRight 右方向 To + Right
'xlToLeft 左方向 To + Left
'xlUp 上方向 Toがない


'◆ワークシートの最終行列()
a = Rows.Count 'Excel2003まで→65536、Excel2007以降→1048576
b = Columns.Count

End Sub

■Sub セル範囲の選択1()
'データが入力されているかたまりを選択
'空白行と空白列がある外は含まれない

Range("A1").CurrentRegion.Activate

End Sub

■Sub セル範囲の選択2()

Range(Range("A1"), ActiveCell.SpecialCells(xlLastCell)).Select

'始点セル → Range("A1")…任意のセル
'終点セル → ActiveCell.SpecialCells(xlLastCell)

End Sub

■Sub セル範囲の選択3()
'入力範囲を調べる
'Cell の 最終行と最終列を検出 を参照

Dim 上, 左, 下, 右 As Long

Windows("1006k.csv").Activate
'Sheets("SSS").Select 'シートを選択する ※1
上 = 1 '基点セルの行番号(この場合はA1の1) ※2
左 = 1 '基点セルの列番号(A1のAの数字表記) ※2
下 = Range(Cells(上, 左), Cells(上, 左)).End(xlDown).Row '下端検出
右 = Range(Cells(上, 左), Cells(上, 左)).End(xlToRight).Column '右端検出
Range(Cells(上, 左), Cells(下, 右)).Select '検出した範囲を選択

End Sub

■Sub 最終行と最終列を検出2_データ範囲を選択する()
'「最終行と最終列を検出1」では、データ入力範囲内の空欄があると正しく値を取得できない
'以下はワークシートで使用されているセル範囲(空欄があっても正しくデータ範囲を検出できる)

ActiveSheet.UsedRange.Select

End Sub

■Sub 最終行と最終列を検出2()
'UsedRange(上記)を使って最終行列番号を取得

Dim oRange As Range 'データ入力範囲
Dim lRowT As Long '最上端行
Dim lRowB As Long '最下端行
Dim lColumnL As Long '最左端列
Dim lColumnR As Long '最右端列

'UsedRangeでデータの範囲を自動的に求めます
Set oRange = ActiveSheet.UsedRange

'範囲から、上下の行番号と左右の列番号を求めます
':上下
lRowT = oRange.Row
lRowB = lRowT + oRange.Rows.Count - 1
':左右
lColumnL = oRange.Column
lColumnR = lColumnL + oRange.Columns.Count - 1

MsgBox "開始行は : " & lRowT & vbCrLf & "最終行は : " & lRowB & vbCrLf & "最左列は : " & lColumnL & vbCrLf & "最右列は : " & lColumnR

End Sub

■Sub 連結状態を調べる()

Dim x As Variant
Range("A1").Select
MsgBox "セルA1の結合範囲は、""" & _
Selection.Address(False, False) & """です。"
x = Selection.Address(False, False)

Range("B1").Select

Range(x).Select

End Sub

■Sub 変数を格納()
'シート名やセル番地などを変数に格納する方法(Set xx As [Application,Workbook,Worksheet,Range,Shape,Window・・・])

Dim buf As Object 'オブジェクト型変数を宣言する "~As Worksheet"でもよい
Set buf = Worksheets("Sheet1") '変数「buf」にSheet1(Worksheetオブジェクト)を入れる
buf.Tab.ColorIndex = 3 'Sheet1のシート見出し色を赤にする
Set buf = Nothing

Dim buf As Object 'オブジェクト型変数を宣言する "~As Range"でもよい
Set buf = Range("A1") '変数「buf」にセルA1(Rangeオブジェクト)を入れる
MsgBox buf.Width 'セルA1の横幅(Widthプロパティ)を調べる
Set buf = Nothing

'Nothingを代入することで、変数と特定のオブジェクトとの関係を無効にして、使われていたシステムリソースおよびメモリリソースを解放する。

End Sub

■Sub 並び替え1()
'以下はデータリストがA1から始まり、行や列が順次増えたり減ったりして特定できないケース

Dim lRow As Long
Dim lCol As Long
Dim myRng As Range

With Worksheets("Sheet1")
lRow = Cells(Rows.Count, 1).End(xlUp).Row
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
Set myRng = .Range(Cells(1, 1), Cells(lRow, lCol))
myRng.Sort _
Key1:=.Range("G1"), _
Order1:=xlDescending, _
Header:=xlYes, _
Orientation:=xlTopToBottom
Set myRng = Nothing
End With

'メソッド:Sort

'引数 定数 内容
'Key1 セル番地など 文字列、Rangeオブジェクトを指定します。
'Order1 xlAscending 昇順に並び替える
' xlDescending 降順に並び替える
'Key2 セル番地など 2番目に優先される文字列。Rangeオブジェクトを指定
'Order2 Order1に同じ
'Key3 セル番地など 3番目に優先される文字列。Rangeオブジェクトを指定
'Order3 Order2に同じ
'Header xlGuess 先頭行をタイトル行か自動判定する
' xlNo 先頭行をタイトル行と見なさない
' xlYes 先頭行をタイトル行と見なす
'OrderCustom 省略すると、通常の並替順。
'  ユーザー設定の並替順のリスト内の番号を示す、1から始まる整数を指定
'MatchCase TRUE 大文字・小文字を区別する
' FALSE 大文字・小文字を区別しない
'Orientation xlTopToBottom 上から下へ(行の並び替え)
' xlLeftToRight 左から右へ(列の並び替え)
'SortMethod xlPinYin 並べ替えの種類を指定-ふりがなを使う
' xlStroke 並べ替えの種類を指定-ふりがなを使わない
'DataOption1~3※ xlSortNormal 数値データとテキストデータを別々に並べ替え
' xlSortTextAsNumbers テキストを数値データとして並べ替え

'※Excel2002で追加された引数、以前のバージョンでは使えません。
'各引数は省略可能。省略すると前回の設定が受け継がれる。

End Sub

■Sub 並べ替え2()
'(P=16列を降順→G=7列を昇順→B=2列を昇順)

Range(Cells(1, 1), Cells(xlower, 26)).Sort _
Key1:=Worksheets("貼り付けシート").Cells(1, 16), Order1:=xlDescending, _
Key2:=Worksheets("貼り付けシート").Cells(1, 7), Order2:=xlAscending, _
Key3:=Worksheets("貼り付けシート").Cells(1, 2), Order3:=xlAscending

'↑これだとタイトル行もデータ行とみなされる。
'タイトル行を指定する場合は、最後に Header:=xlYes を追加する。

End Sub

■Sub ソート()

'上の「並び替え」を参照

End Sub

■Sub 名前をすべて削除()

Dim n As Name
For Each n In ActiveWorkbook.Names
On Error Resume Next 'エラーを無視
n.Delete
Next

End Sub



PR
2015/04/14 22:18 | Excelマクロ(VBA) | コメント(0)
<<Common | ホーム | ErrSet1>>
コメント
コメントの投稿















前ページ | ホーム | 次ページ