【マクロ】選択した範囲のアドレスを取得する

シート上で実際に選択した範囲からそのアドレスを取り出す方法

標準モジュールに
Sub rangeaddress()
Range(g_cnsclearrange).ClearContents
End Sub

イミディエイトウィンドウに
?selection.address
と、入力してEnterを押す
結果
?selection.address
$B$4:$C$6,$E$4,$F$7:$F$8
と、書き出される。

結合された範囲でも取得が出来る。


※注意点
まず、選択したセル範囲のアドレスが表記上であまりにも長い(限度は未確認ですが)場合、「イディミエイトウィンドウ」上に全てが表示されない場合がある。
 このような場合は、表示されるアドレス文字列の右端が最後に選択したセル(セル範囲)かどうか確認すること。
もう一つ、Rangeプロパティに指定できるセル範囲を示す文字列の長さにも限度があり、
これを超えていると実行時にエラーとなる。
この場合は、文字列を複数に分けて順に利用するように。

【マクロ】RGB色見本を作成するマクロ

Sub RGB値色見本作成()
  Dim rr As Long, gg As Long, bb As Long
  Dim r As Long: r = 1  ' 行番号
  Dim c As Long: c = 1  ' 列番号
  For rr = 0 To 255 Step 51
    For gg = 0 To 255 Step 51
      For bb = 0 To 255 Step 51
        With Cells(r, c)
          .Interior.Color = RGB(rr, gg, bb)
          .Value = "#" & _
            Format(Hex(rr), "00") & _
            Format(Hex(gg), "00") & _
            Format(Hex(bb), "00")
        End With
        r = r + 1
      Next bb
      r = r - 6
      c = c + 1
    Next gg
    r = r + 6
    c = c - 6
  Next rr
  Columns("A:F").AutoFit
End Sub

【マクロ】抽出に利用している項目名を取得する

オートフィルターで絞っている列の項目名を抽出する。



Sub 絞り込みを行っているフィールド名を調べる()

　Dim aft As AutoFilter
　Dim fld As String　' フィールド名
　Dim i As Long
　If Not ActiveSheet.FilterMode Then Exit Sub
　Set aft = ActiveSheet.AutoFilter
　For i = 1 To aft.Filters.Count
　　If aft.Filters(i).On Then
　　　fld = fld & _
'　　　　aft.Range.Cells(1, i).Value & vbCrLf　'改行して表示
　　　　aft.Range.Cells(1, i).Value & "/"　'スラッシュで区切って表示
　　End If
　Next i

　  Worksheets("Sheet1").Select
    Range("H3") = fld　　'値を返す
'右側から一文字削除する
    Range("H3") = Mid(Range("H3"), 1, Len(Range("H3")) - 1)
End Sub

【マクロ】フィルター後に特定列のコピペ

With Sheets("Sheet1")
.Range(.Range("Q2"), .Range("Q" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy
Sheets("Sheet2").Range("C2").PasteSpecial Paste:=xlPasteValues
End With


.Range(.Range("A2"), .Range("D" &
とすると、A列からD列となる。 

【マクロ】フラグを立てる

C列～G列の3行目からどこかに1が入っていればJ列に1と入れる。

何も入っていなければNGと入れ、文字列であればハイフンを入れる。

Sub A()
Dim i As Long
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
If WorksheetFunction.CountIf(Range("C" & i & ":G" & i), 1) > 0 Then
Cells(i, "J") = '1が入っていれば1を返す
ElseIf WorksheetFunction.CountBlank(Range("C" & i & ":G" & i)) = 5 Then
Cells(i, "J") = "NG"　'空欄であればNGを返す
Else
Cells(i, "J") = "-"　'文字列であればハイフンを返す
End If
Next
End Sub

【マクロ】選択したセルを返す

選択したセルを別の列に返す。
AからG列で複数セルを飛び地等で選択した値を
K列からに返す。

Sub 抜き出し()
Application.ScreenUpdating = False
Application.EnableEvents = False
Range("K2").Resize(Rows.Count - 1, 7).ClearContents
For Each c In Selection
Cells(Rows.Count, c.Column + 10).End(xlUp).Offset(1).Value = c.Value
Next c
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

【マクロ】セルの上下に余白を持たせ表を見やすくする

Sub NiceRowheight()
'余白設定
Const buf = 10
Application.ScreenUpdating = False
'とりあえず選択範囲の行高さをAutoFitする
Selection.Rows.AutoFit
'選択範囲が広すぎる時のために、データ最終行を獲得しておく
maxrow = Range("A1").SpecialCells(xlLastCell).Row
'その後、微妙に行高さを広げる。（１列目のみ処理）
For Each hoge In Selection.Columns(1).Cells
    hoge.RowHeight = hoge.RowHeight + buf
    '経過観察＆終了判定
    i = i + 1
    If i Mod 2000 = 0 Then
        '終了判定（データの最終行を越えてたら終了する。）
        If hoge.Row > maxrow Then Exit For
        Application.StatusBar = i
        DoEvents
    End If
Next
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub