Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
11629 / 13665 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【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 -
引用なし
パスワード
   Ｂ列、Ｄ列に対し、２行ごとに　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 -
引用なし
パスワード
   皆さん回答ありがとうございました。
３人の回答のうちichinoseさんのものが
一番私がやりたかったものに近かったので
これを使わせていただきました。
その結果、ちゃんとできました！
本当にありがとうございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
11629 / 13665 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free