1行づつデータを移動させたい

質問

Excel VBAを使用してます。

列Dにデータがずらっと入っています。
(1)偶数個目にあるデータをその1個前の列Eに移動する。

(2)空白となったD列は上方向に詰める。

という処理を書きたいのです。

VBA歴が浅いためひらめきません。よろしくお願いします。m(__)m

回答No.3

hallo-2007

こういった場合は、無理にデータのシートを変更せずに
別途、シートを使ったほうが良いです。
例
別途、テンポラリ　ちいうシート名のシートを準備していて
Sub ボタン1_Click()
With Sheets("テンポタリ")
For i = 1 To Range("D" & Rows.Count).End(xlUp).Row
If i = Int(i / 2) * 2 Then
.Range("E" & Int(i / 2)).Value = Range("D" & i).Value
Else
.Range("D" & Int(i / 2) + 1).Value = Range("D" & i).Value
End If
Next
End With
End Sub

を実行します。
ご希望通りになったら、元シートを削除してもよいですし
残しておくのも何らかの場合に役に立つこともあるでしょう。

元データのシートを残しておくなら
抽出する別シートの　
D列に　=INDEX(データシート!D:D,ROW()*2-1)&""
E列に　=INDEX(データシート!D:D,ROW()*2)&""
と入れて下までコピーしておくだけでも良いと思います。

回答No.2

cj_mover

こんにちは。お邪魔します。

まず
求める結果の確認ですが、

{D列]{E列]
　D1
　D2
　D3
　D4
　D5
　D6

　↓

{D列]{E列]
　D1　D2
　D3　D4
　D5　D6

（こういう解釈で書いています。）
もし、こちらの理解が至っていない場合は、
補足欄にでも書いてみてください。

いくつか書いてみましたが２例だけ挙げておきます。
どちらも10,000行のサンプルで動作確認しています。

まず、
比較的初歩的な機能で、
手作業マクロっぽく作業列を使うマクロを挙げてみます。
セルの削除をする仕様としては悪くない処理速度だと思います。

Sub Re8142894a()
' ' Excel描画更新停止（速く処理する為）
　　Application.ScreenUpdating = False
' ' 一旦、Ｄ列左に列挿入（作業列）
　　Columns("D").Insert
' ' 最終行位置取得しつつ、処理対象範囲の左隣を捉えて
　　With Range("D2:D" & Cells(Rows.Count, "E").End(xlUp).Row)
' ' 奇数なら１、偶数ならエラー、を返す数式を設定
　　　　.Formula = "=1/(Mod(ROW(),2))"
' ' エラー値を返すセル（偶数行）だけを選択
　　　　.SpecialCells(xlCellTypeFormulas, xlErrors).Select
　　End With
' ' 作業列を削除→Ｅ列に転記するべきセルだけが選択状態
　　Columns("D").Delete
' ' 選択範囲をコピーしてＥ列に貼付け
　　Selection.Copy Destination:=Cells(1, "E")
' ' 選択範囲を削除して上方向に詰める
　　Selection.Delete xlShiftUp
' ' Excel描画更新再開
　　Application.ScreenUpdating = True
End Sub

行数が多い場合は、セルの削除が大きく時間を取るので、
キツイかも知れません。
そこで、配列変数を使う例も挙げておきます。
こちらは中級向け。
セルの値だけを転記する内容ですので、
セルの書式については必要なら別途手当てするようになります。

Sub Re8142894j()
　　Dim v()
　　Dim nBtm As Long
　　Dim i As Long
' ' 最終行位置取得
　　nBtm = Cells(Rows.Count, "D").End(xlUp).Row
' ' 処理対象範囲を２列分で捉えて
　　With Range("D1:E" & nBtm)
' ' すべての値を配列変数に格納
　　　　v() = .Value
' ' ２行めから最終行までループ
　　　　For i = 2 To nBtm
' ' 奇数行なら
　　　　　　If i And 1 Then
' ' Ｄ列にあったデータを　Ｅ列上から順次転記
　　　　　　　　v((i + 1) \ 2, 1) = v(i, 1)
' ' 偶数行なら
　　　　　　Else
' ' 元の行位置の半分にあたる行位置にＤ列デ－タを転記
　　　　　　　　v(i \ 2, 2) = v(i, 1)
　　　　　　End If
　　　　Next i
' ' 要らなくなったＤ列のデータをすべて消す
　　　　For i = (nBtm + 3) \ 2 To nBtm
　　　　　　v(i, 1) = Empty
　　　　Next i
' ' 処理対象範囲２列分に配列変数の値すべてを出力
　　　　.Value = v()
　　End With
' ' 配列変数の初期化
　　Erase v()
End Sub

回答No.1

tsubuyuki

質問中にどうにも曖昧な記述が目立つので、完全な回答とはいえません。

とりあえず、おっしゃるとおりの
> 偶数個目にあるデータ
　　=>　偶数行のＤ列　と読み替え
> その1個前の列E
　　=>　例えば「Ｄ２セルをＥ１セルに移動」と判断
> 空白となったD列は上方向に詰める
　　=>　単純に「セル」を削除して上方向にシフト
という処理であれば、以下で出来ます。

Sub Sample1()
　　　　For i = Cells(Rows.Count, 4).End(xlUp).Row To 1 Step -1　　' （３）
　　　　　　　　If i Mod 2 = 0 Then　　' （２）
　　　　　　　　　　　　Cells(i - 1, 5) = Cells(i, 4)
　　　　　　　　　　　　Cells(i, 4).Delete Shift:=xlUp　　' （１）
　　　　　　　　End If
　　　　Next
End Sub

これが、例えば
偶数行全体を消したいなら、（１）のところを
　　　　Rows(i).Delete
に変えてやります。

データが偶数行から始まる＝奇数行を消したいなら、（２）を
　　If i Mod 2 = 1 Then
に変えてやります。

（３）の「To 1」は、実際の「データの開始行」にしておくと無難です。
コレを自動的に取得する方法もありますが、
途中で空白セルが噛んだり、表の一番上の行が項目名だったりすると
ちょっとした工夫が必要で厄介なのであまりオススメしません。
どうしてもそうしたい場合は「詳細な現状」をご説明下さい。

なお、
> その1個前の列Eに
コレが「１個前の偶数行のＥ列に」という意味だとすると、更なる工夫が必要です。
面倒なので今回は考えていませんので悪しからずご了承下さい。

> 列Dにデータがずらっと
「途中で空白セルを挟みつつ、ずらっと。その出現順に（空白数を除いて）偶数個目」
だとすると、これまた工夫が必要です。
これも面倒なので今回は考えていませんので悪しからずご了承下さい。

以上、参考までに。

追記）
ＶＢ(Visual Basic)　と　ＶＢＡ(Visual Basic for Apprications)は似て非なるものです。
これも一応、参考までに。