'************************************************************
 
   'シートのプロテクト
    ActiveSheet.Protect

    'シートのプロテクトの解除
    ActiveSheet.Unprotect

'************************************************************

＜画面の制御＞

'************************************************************

    '画面の動きを止める   
    Application.ScreenUpdating = False

    '画面の動きを再開する   
    Application.ScreenUpdating = True

'************************************************************

＜オートフィルター＞

'************************************************************

    'オートフィルターがかかっているかどうか判断する
    If ActiveSheet.AutoFilterMode = True Then
        'オートフィルターがかかっています
        MsgBox "filter on"
         'オートフィルターの解除
        Selection.AutoFilter
   Else
        'オートフィルターがかかっていません
        MsgBox "filter off"
    End If

'************************************************************

＜カーソルの移動＞

'************************************************************

    'カーソルの移動方向を変更する
    Application.MoveAfterReturnDirection = xlDown       'カーソル移動を下方向へ
    Application.MoveAfterReturnDirection = xlToRight    'カーソル移動を右方向へ

    'カレントセルを入力されている最後の行へ移動させる（上から下へ）
    Range("A1").Select
    Selection.End(xlDown).Select

    'カレントセルを入力されている最後の行へ移動させる（下から上へ）
    Range("A10000").Select
    Selection.End(xlUp).Select

    'オフセット命令(１行下へ）
    '              (行、列)
    Selection.Offset(1, 0).Select

    'オフセット命令(１列右へ）
                   (行、列)
    Selection.Offset(0, 1).Select

'************************************************************

＜テキストボックス・コンボボックス＞

'************************************************************

'テキストボックス１の内容をＡ１のセルに転記する
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Range("A1") = TextBox1.Text
End Sub

'************************************************************

'Ａ２のセルの内容をテキストボックス１に転記する
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    TextBox2.Text = Range("A2")
End Sub

'************************************************************

    'コマンドボタンからテキストボックスへフォーカスを移動する際に、
    'テキストボックスの文字を全部選択状態にするには、コマンドボタン
    'をクリックした時に次の命令を実行する

    SendKeys "{TAB}"

'************************************************************

Private Sub UserForm_Initialize()
    'コンボボックスのリストに列名をセットする
    ComboBoxリスト.AddItem Range("D1")
    ComboBoxリスト.AddItem Range("E1")
    ComboBoxリスト.AddItem Range("F1")
    ComboBoxリスト.AddItem Range("G1")
    ComboBoxリスト.AddItem Range("H1")
    ComboBoxリスト.AddItem Range("I1")
    ComboBoxリスト.AddItem Range("J1")
End Sub

'************************************************************

＜検　索＞

'************************************************************

'Ｌ６のセルに　前　の字があるかどうかを調べ、あれば、メッセージを表示
    Range("L6").Select
    If Range("L6") Like "*前*" Then
        MsgBox "「前」見っけ"
    End If

'************************************************************

    Dim sGyo As Integer  '検索して見つかった行を記憶する変数
    Dim wRowL As Integer '検索範囲の最後の行数を記憶する変数
   
    Worksheets("リスト").Activate
    wRowL = 10000
    sGyo = wRowL
   
    With Worksheets("リスト").Range("A2:A" & wRowL & "")
       '番号で検索する。
       Set c = .Find(Txt番号.Text, LookIn:=xlValues)
       If Not c Is Nothing Then
           firstAddress = c.Address
           sGyo = c.Row
       Else
           GoTo FindError
       End If
    End With

FindError:
 'エラー処理

'************************************************************

＜エラー処理＞

'************************************************************

'エラーが発生した時の処理
On Error GoTo err_01

    'オフセット命令(１行上へ）
                   (行、列)
    Selection.Offset(-1, 0).Select

'エラー（この場合、上へ１行けないとき）の処理
err_01:
    Exit Sub

'************************************************************

＜セル選択・値の取得・文字列変換＞

'************************************************************

   '人数の受け入れ
    ninzu = InputBox("人数を入力してください。", "人数の入力")

'************************************************************

'メッセージボックスを表示して　OK、キャンセルの判断を求める
    w_yn = MsgBox("　すべてクリアします。よろしいですか？" & Chr(13) _
         & "  復活できませんので、念のため保存をしておいてください。", vbOKCancel, " クリア")
     'w_yn=1:OK, =2:Cancel
     'キャンセルを選んだとき
    If w_yn = 2 Then
        Exit Sub
    End If

'メッセージボックスを表示してイエス、ノーの判断を求める
Sub Macro2()
    Dim w_yn As Integer
    ActiveWindow.SelectedSheets.PrintPreview
    w_yn = MsgBox("印字しますか？", vbYesNo, "印字")
    If w_yn = 6 Then
        ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    End If
End Sub

'メッセージボックスを表示してイエス、ノー、キャンセルの判断を求める
     w_yn = MsgBox("削除しますか？", vbYesNoCancel, "重複データの削除")
     'w_yn=6:Yes, =7:No, =2:Cancel
     'キャンセルを選んだとき
     If w_yn = 2 Then
         Exit Sub
     End If
     'Yes　を選んだとき
     If w_yn = 6 Then
         Selection.Delete Shift:=xlUp
     End If

'************************************************************

    '列と行を数字で指定してセルを選択する
    '      行    列
    Cells(wRow, wCol).Select

    '複数セルの選択
    Range(Cells(5, ActiveCell.Column), Cells(10000, ActiveCell.Column)).Select

'************************************************************

    '数値の入っているセルだけを選択する
    Selection.SpecialCells(xlCellTypeConstants, 1).Select

'************************************************************

'カレントセルの行、列を取得し、そのセルの内容を表示する

   '現在の行を記憶する変数
    Dim w_Gyo As Long
    '現在の列を記憶する変数
    Dim w_Retu As Integer
    '数字をアルファベットへ変換するための変数
    Dim a_Retu As String
   
    '現在の行を記憶する（１行目＝１から始まる数字）
    w_Gyo = ActiveCell.Row
    '現在の列を記憶する（Ａ列＝１から始まる数字）
    w_Retu = ActiveCell.Column
   
    '記憶した行、列を表示する
    MsgBox "現在の行は： " & w_Gyo
    MsgBox "現在の列は： " & w_Retu
   

'************************************************************

    
    'w_Retuをアルファベットへ変換する（ Chr(65)　は　A を示す）
    a_Retu = Chr(w_Retu + 64)
    '                                       ( 列       行 )
    MsgBox "現在のセルの内容は： " & Range(a_Retu & w_Gyo & "").Text

'************************************************************

    
    カラム数をＡＢＣの文字へ変換する
    Select Case ActiveCell.Column
        Case Is < 27
            retsumoji = Chr(ActiveCell.Column + 64)
        Case Is < 53
            retsumoji = "A" & Chr(ActiveCell.Column + 64 - 26)
        Case Is < 79
            retsumoji = "B" & Chr(ActiveCell.Column + 64 - 52)
        Case Is < 105
            retsumoji = "C" & Chr(ActiveCell.Column + 64 - 78)
    End Select

    'アクティブセル番地をＡ１形式で表示する
    MsgBox ActiveCell.Address(xlA1)

    'アクティブセル番地のＡ１形式から列番号のみを抽出する
    Dim w_ACol As String   
    w_ACol = Replace(Left(ActiveCell.Address(xlA1), 3), "$", "")

'************************************************************

    '文書番号と発送日を入力させる
   
    Dim aa As String
    Dim bb As Date

    aa = InputBox("文書番号を入力してください。", "文書番号")
    bb = InputBox("発送日を入力してください。", "発送日")
   
    MsgBox "第 " & aa & " 号"
    MsgBox Format(bb, "ggge年mm月dd日")

'************************************************************

    '日付の設定

    '選択したセルの表示形式を「月曜日」のように設定
    Range("A1").Select
    Selection.NumberFormatLocal = "aaaa"
   
    '選択したセルの表示形式を「月」のように設定
    Range("A2").Select
    Selection.NumberFormatLocal = "aaa"
   
    '選択したセルの表示形式を「(月)」のように設定
    Range("A3").Select
    Selection.NumberFormatLocal = "(aaa)"
   
    '選択したセルの表示形式を「monday」のように設定
    Range("A4").Select
    Selection.NumberFormatLocal = "dddd"
   
    '選択したセルの表示形式を「mon」のように設定
    Range("A5").Select
    Selection.NumberFormatLocal = "ddd"
   
    '選択したセルの表示形式を「平成17年04月11日(月)」のように設定
    Range("A6").Select
    Selection.NumberFormatLocal = "ggge年mm月dd日(aaa)"
   
    '選択したセルの表示形式を「平成17年4月4日(月)」のように設定
    Range("A7").Select
    Selection.NumberFormatLocal = "gge年m月d日(aaa)"
   
    '選択したセルの表示形式を「H17.4.4(月)」のように設定
    Range("A8").Select
    Selection.NumberFormatLocal = "ge.m.d(aaa)"
   
    'フォーマット関数を使って
    '選択したセルの表示形式を「平成17年04月11日(月)」のように設定
    Range("A9") = Format(DateValue("2005/4/11"), "ggge年mm月dd日(aaa)")

'************************************************************

'キー入力した内容を送る
Private Sub Report_Activate()
    SendKeys "%vz{down}{down}{down}{enter}"
End Sub

'************************************************************

    'セルの背景色を変える
    Range("A1").Select
    Selection.Interior.ColorIndex = xlNone      '色無しにする
    Selection.Interior.ColorIndex = 3           '赤色にする

'************************************************************

    'テキストボックスの内容をカンマ付数字で表示する
    TextBox1.Text = Format(TextBox1.Text, "#,##0")

'************************************************************

    'テキストボックスの内容を３桁づつスペースで区分けして表示する
    TextBox1.Text = Format(TextBox1.Text, "### ### ### ###")

'************************************************************

    'マイナス表示を△表示に変換する
    Range("A1") = Replace("- 123 456", "-", "△ ", 1, , vbTextCompare)

'************************************************************

'「"」を数式の中に入れるには

    'A1セルに　「=IF(B1="","a",C1)」　という式を入れたい

    Range("A1") = "=IF(B1="""",""a"",C1)"

    ' A1　のセルに「="大阪府"&C1」と数式を入れたい。「"」は Chr(34) で表せる
    '下記の例で、 C1 セルに「大阪市」と入っており、
    '実行結果は、　A1 のセルに「大阪府大阪市」と表示される。
   
    Range("A1") = "=" & Chr(34) & "大阪府" & Chr(34) & "&C1"

'************************************************************

'セルへ数式を入れるサンプル

Private Sub Workbook_Open()
   
    Application.ScreenUpdating = False
    Sheets("送付書").Select
    Range("J15") = "=VLOOKUP(J1,支店リスト!$A$5:$O$416,12,0)"
    Range("J16").Select
    ActiveCell.FormulaR1C1 = "=VLOOKUP(R[-15]C,支店リスト!R5C1:R416C15,15,0)"
    Range("A26").Select
    ActiveCell.FormulaR1C1 = "=" & Chr(34) & "本店      " & Chr(34) & _
        "&VLOOKUP(R[-25]C[9],支店リスト!R5C1:R416C12,3,0)"
    Sheets("支店リスト").Select
    Application.ScreenUpdating = True
End Sub

'************************************************************

'ほかのBookのセルから値を転記する

    Sheets("Sheet1").Range("A1") = _
             Workbooks("Book2.xls").Sheets("Sheet1").Range("A1")

'************************************************************

小数点以下を切り上げる

    Dim pNum As Integer
   
    Sheets("Sheet1").Select
    wCol = ActiveCell.Row
    pNum = Round((wCol - 2) / 40, 0)
   
    If pNum < ((wCol - 2) / 40) Then
        pNum = pNum + 1
    End If

'************************************************************

小数点以下を切り上げる（その２）　ワークシート関数を使用

    Dim rndUp As Integer
   
    '小数点以下を切り上げる
    rndUp = Application.WorksheetFunction.RoundUp(1.1, 0)
   
    MsgBox rndUp

'************************************************************

Wait メソッドの使用例

次の使用例は、実行中のマクロを当日の午後 6 時 23 分まで停止します。

Application.Wait "18:23:00"
次の使用例は、実行中のマクロを約 10 秒間停止します。

newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 10
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
次の使用例は、10 秒を過ぎるとメッセージを表示します。

If Application.Wait(Now + TimeValue("0:00:10")) Then
    MsgBox "時間が過ぎました。"
End If

'************************************************************

'配列関数で支店名を入れる

    Dim w_Jimmei As Variant
    w_Jimmei = Array(, "北海道", , "青　森", "宮　城", , , , , , "東　京", _
                   "神奈川", , , , "静　岡", "愛　知", "京　都", "大　阪", _
                   "兵　庫", "福　岡", "鹿児島")

        Range("F" & w_Row & "") = w_Jimmei(Range("B" & w_Row & ""))

'************************************************************

＜ファイル操作＞

'************************************************************

'ファイル名を変更して保存する

    Dim wrkName As String

    wrkName = ActiveWorkbook.Name
   
    ActiveWorkbook.SaveAs Filename:="Y:\BACKUP\担当用\" & "次" & wrkName, _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
   
    wrkName = ActiveWorkbook.Name
    MsgBox "ファイル名を " & wrkName & " に変更し、保存しました。" _
        & Chr(13) & "後で、ファイル名を適切な名称に変更してください。", _
        , "ファイル名の変更"

'************************************************************

'ファイルを保存しないでエクセルを強制終了する
Application.DisplayAlerts = False      'ファイルを保存しない
Application.Quit                       'エクセルの終了

'************************************************************

'ファイルを保存後エクセルを強制終了する
    '保存し終了
    ActiveWorkbook.Save
    Application.Quit

'************************************************************

'ファイルを開くダイアログを開く

 Application.GetOpenFilename "Excelファイル (*.xls), *.xls", , , , false

'

'************************************************************

大阪城公園の桜です。あと1月半くらいで今年もきれいに咲いてくれるでしょう。