EXCEL2000 VBA 上に移動

EXCEL2000 VBA  上に移動

再生できない場合、ダウンロードは🎥こちら

Sub 入れ替えswap()

'選択セルと1つ上のセルの値を入れ替える（上に移動）

    Dim sR, sC As Long

    Dim D1, D2 As Variant

 

        On Error GoTo owari '1行目を選択したときのエラー対策

 

'選択セルの行列を調べる

    sR = Selection.Row

    sC = Selection.Column

'値を変数に代入

    D1 = Cells(sR, sC)

    D2 = Cells(sR - 1, sC)  '１つ上のセル

'セルに書き込み

    Cells(sR, sC) = D2

    Cells(sR - 1, sC) = D1

'セル選択

    Cells(sR - 1, sC).Select

'1行目を選択してエラーが出たらこのラベルに飛んで来る

owari:

     Exit Sub

 

End Sub

 

 

---

追記　複数列に対応

 

Sub 選択範囲を上に移動()

 

'選択範囲（1行）を上に移動（値のみ）

 

    Dim sR, sC, sCcont, sRcont As Long

    Dim D1(), D2()

    Dim i As Long

 

         On Error GoTo owari '1行目を選択したときのエラー対策

 

'選択範囲を調べる

    sR = Selection.Row

    sC = Selection.Column

    sCcont = Selection.Columns.Count

    sRcont = Selection.Rows.Count

 

'選択範囲の行が1列以上なら、メッセージを表示して終了

    If sRcont > 1 Then MsgBox "選択行範囲は1行にしてください": Exit Sub

 

'選択範囲の値をD1()配列に格納

    ReDim D1(sCcont), D2(sCcont)

 

     For i = 1 To sCcont

        D1(i) = Cells(sR, sC + i - 1).Value

       ' Debug.Print D1(i)

     Next i

 

'１つ上の範囲の値をD2()に格納

    For i = 1 To sCcont

        D2(i) = Cells(sR - 1, sC + i - 1).Value

        'Debug.Print D2(i)

    Next i

 

'選択範囲に1つ上のセルの値を代入

    For i = 1 To sCcont

        Cells(sR, sC + i - 1) = D2(i)

        Cells(sR - 1, sC + i - 1) = D1(i)

    Next i

'選択範囲を移動

    Range(Cells(sR - 1, sC), Cells(sR - 1, sC + sCcont - 1)).Select

 

'1行目を選択してエラーが出たらこのラベルに飛んで来る

owari:

     Exit Sub

 

End Sub

 

 

タグ：Excel2000 VBA