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

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

【マクロ】実行後に元のセルに戻る

ボタンを押してマクロ実行後、ボタンがアクティブの状態でマクロが終了する。
元のセルに戻すコードがこれだ。


シートを追加した時などには、アクティブなシートは、意図せずに、変更されてしまいますよね。
とりあえず、選択していたところへ戻る。
Sub 例1()
Dim xCur As Range
Set xCur = Selection
'
'本来行うべき処理のコードをここに記入
'
With xCur
.Parent.Parent.Activate '元のブックへもどる
.Parent.Activate '元のシートへもどる
.Activate 'もとの選択範囲を選択
End With
End Sub

アクティブセルも回復するには

Sub 例２()
Dim xCur As Range, xAct As Range
Set xCur = Selection
Set xAct = ActiveCell
'
'本来行うべき処理のコードを記入
'
With xCur
.Parent.Parent.Activate '元のブックへもどる
.Parent.Activate '元のシートへもどる
.Activate 'もとの選択範囲を選択
End With
xAct.Activate 'アクティブセル回復
End Sub
「元のブックへもどる」「元のシートへもどる」のは、プログラムの状況により、不要になるので、適宜変更してください。

【マクロ】選択範囲を画像ファイルに保存

吐き出した画像はドキュメントの中に保存される。


Sub 選択範囲を画像ファイルに保存()
    With Selection
        .CopyPicture Appearance:=xlScreen, Format:=xlBitmap
        With ActiveCell.Worksheet.ChartObjects.Add(.Left, .Top, .Width, .Height)
            With .Chart
                .Paste
                .Export "test.png", "png"
            End With
            .Delete
        End With
    End With
End Sub

【マクロ】条件に合致した行を削除するExcelマクロ

条件に合致した行を削除するExcelマクロ

A列に必ず値が入っていること。

Sub 条件に一致した行を削除する()
　Dim i As Long

　For i = Range("A1").End(xlDown).Row To 2 Step -1
　With Cells(i, "G")
　　If _
　　.Value Like "東京*" Or _
　　.Value Like "大阪*" Then
　　　.EntireRow.Delete
　　End If
　End With
　Next i
End Sub

A列の一番下のデータから上方向に向かってループを回して、
　For i = Range("A1").End(xlDown).Row To 2 Step -1

もしも、G列のデータが「東京」か「大阪」で始まっていたら、
　With Cells(i, "G")
　　If _
　　.Value Like "東京*" Or _
　　.Value Like "大阪*" Then

その行全体を削除しています。
　　　.EntireRow.Delete

上記のマクロは、A列に必ずデータが入っているという条件にしているので、「Range("A1").End(xlDown).Row」というコードでA列の一番下の行番号を取得しています。

もしA列に空白セルが存在する可能性があるのなら「Cells(Rows.Count, 1).End(xlUp).Row」というコードにしましょう

【マクロ】リストからシート連続作成

リストを選択してマクロを実行する。

Sub リストから連続シート作成()
'シート名にしたいセル範囲を指定し実行
  Dim shname As Range
  For Each shname In Selection
        Sheets.Add after:=ActiveSheet
        ActiveSheet.Name = shname.Value
   Next shname
End Sub