Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


11609 / 13645 ツリー ←次へ | 前へ→

【15152】セルの値の移動 レイレイ 04/6/16(水) 17:01 質問[未読]
【15159】Re:セルの値の移動 IROC 04/6/16(水) 18:42 回答[未読]
【15160】Re:セルの値の移動 ichinose 04/6/16(水) 18:45 回答[未読]
【15163】Re:セルの値の移動 Asaki 04/6/16(水) 23:09 回答[未読]
【15170】できました! レイレイ 04/6/17(木) 10:23 お礼[未読]

【15152】セルの値の移動
質問  レイレイ  - 04/6/16(水) 17:01 -

引用なし
パスワード
   こんにちは。
VBA初心者です。

セルの値を斜め上のセルに移動させるという作業をしたいのですが、
どうすればいいでしょうか?

-------------------------------------
A    B    C     D     E
金額 1000       3000 
数量 2000       4000
金額 1000       3000
数量 2000       4000

-------------------------------------

この表の数量(つまり2000と4000)を下の
ように右斜め上に移動させたいのです。

-------------------------------------

A    B    C     D     E
金額 1000   2000    3000   4000
数量    
金額 1000   2000    3000   4000
数量 

-------------------------------------

まだはじめたばかりでよくわからないので
よろしくお願いします。

【15159】Re:セルの値の移動
回答  IROC  - 04/6/16(水) 18:42 -

引用なし
パスワード
   B列、D列に対し、2行ごとに for〜nextでループして、
if文で空白でなければ、右上にコピー
すれば出来るかと思います。

dim i as long

for i = 2 to range("B65536").end(xlup).row step 2
 if cells(i,2).value <> "" then
   cells(i,2).copy cells(i-1,3).copy
 end if
next i

【15160】Re:セルの値の移動
回答  ichinose  - 04/6/16(水) 18:45 -

引用なし
パスワード
   ▼レイレイ さん:

こんにちは。


>セルの値を斜め上のセルに移動させるという作業をしたいのですが、
>どうすればいいでしょうか?
>
>-------------------------------------
>A    B    C     D     E
>金額 1000       3000 
>数量 2000       4000
>金額 1000       3000
>数量 2000       4000
>
>-------------------------------------
>
>この表の数量(つまり2000と4000)を下の
>ように右斜め上に移動させたいのです。
>
>-------------------------------------
>
>A    B    C     D     E
>金額 1000   2000    3000   4000
>数量    
>金額 1000   2000    3000   4000
>数量 
>
>-------------------------------------
'================================
Sub test()
  For idx = 2 To 4 Step 2
'数値がある列の数が例題より多い場合は
'     ↑の数値を変更して下さい
   For jdx = 1 To Cells(Rows.Count, idx).End(xlUp).Row
     If jdx Mod 2 = 0 Then
      With Cells(jdx, idx)
        .Offset(-1, 1).Value = .Value
        .Value = ""
        End With
      End If
     Next
   Next
End Sub

当該シートをアクティブにして実行してみて下さい。
シートのデータが例のような配置だと思って作りました。
確認して下さい。

【15163】Re:セルの値の移動
回答  Asaki  - 04/6/16(水) 23:09 -

引用なし
パスワード
   こんばんは。

とりあえず、2例ほど作ってみました。
>-- 空白を無視するの貼り付け利用
Sub test1()
  Dim i  As Long

  For i = 1 To Cells(65536, 1).End(xlUp).Row Step 2
    With Cells(i + 1, 2).Resize(, 3)
      .Copy
      .Offset(-1, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, _
        SkipBlanks:=True, Transpose:=False
      .ClearContents
    End With
  Next i
End Sub

>-- 配列利用
Sub test2()
  Dim i  As Long
  Dim v  As Variant

  v = Range(Cells(1, 2), Cells(65536, 1).End(xlUp).Offset(, 4)).Value
  For i = 1 To UBound(v) Step 2
    v(i, 2) = v(i + 1, 1)
    v(i, 4) = v(i + 1, 3)
    v(i + 1, 1) = ""
    v(i + 1, 3) = ""
  Next i
  Cells(1, 2).Resize(UBound(v), 4).Value = v
  Erase v
End Sub

【15170】できました!
お礼  レイレイ  - 04/6/17(木) 10:23 -

引用なし
パスワード
   皆さん回答ありがとうございました。
3人の回答のうちichinoseさんのものが
一番私がやりたかったものに近かったので
これを使わせていただきました。
その結果、ちゃんとできました!
本当にありがとうございました。

11609 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free