Excel関数、またはVBA

質問

どなたか教えてください。

写真のようにデータが既に存在します。
(E列:L列)の値を、(H列)がゼロ値でも空セルでもない場合のみ、(P列)がゼロ値でも空セルでもない下行に「値のみ」移動させたいです。
(H列がゼロ値か空セルの場合は移動さない）
E列からL列の値は1行目から始まり、約60行ごとにランダムで存在します。
例えば写真でいうと(H1)が1以上なので、(E1:L1)の値がP1からP5がゼロか空セルのためP6に移動となります。

どうぞよろしくお願いします。

回答No.5

AKARI0418 · ベストアンサー

VBAはあまり詳しくないのでしたね、言葉足らずの回答で申し訳ありませんでした。

Sub TestB()
'E列
Const EColumn As Long = 5
'L列
Const LColumn As Long = 12
'P列
Const PColumn As Long = 16
'H列
Const HColumn As Long = 8

Dim Rng As Range
Dim Movedat() As String
Dim counter As Integer
Dim Wcounter As Integer
Dim i As Long
Dim j As Long

'A列の1行目からP列のデータのある最終行までを取得する。
Set Rng = Range(Cells(1, 1), Range("$P$65536").End(xlUp))

'配列の初期化
ReDim Movedat(0)
counter = -1
Wcounter = -1

For i = 1 To Rng.Rows.Count

'E列～L列のどれかひとつにデータがあるかを判別
If Rng.Cells(i, HColumn) <> vbNullString And _
Rng.Cells(i, HColumn) <> 0 Then
'P列にデータがある場合は移動しない
If Rng.Cells(i, PColumn) = vbNullString Or _
Rng.Cells(i, PColumn) = 0 Then
counter = counter + 1
ReDim Preserve Movedat(counter)
'カンマ区切りで格納
For j = EColumn To LColumn
Movedat(counter) = Movedat(counter) & Rng.Cells(i, j)
If j <> LColumn Then
Movedat(counter) = Movedat(counter) & ","
End If
'セルクリア
Rng.Cells(i, j) = vbNullString
Next j
End If
ElseIf counter <> Wcounter Then
'P列にデータがある場合は書き出す
If Rng.Cells(i, PColumn) = vbNullString Or _
Rng.Cells(i, PColumn) = 0 Then
Else
Wcounter = Wcounter + 1
Dim field() As String
field = Split(Movedat(Wcounter), ",")
For j = EColumn To LColumn
Rng.Cells(i, j) = field(j - EColumn)
Next j
End If
End If
Next i

End Sub

お礼

AKARI0418様

VBAに関してはド素人なんです。
簡単なものは見様見真似で頑張ってます・・・。

早速試させていただきました。
【完璧】です！！
長々とお付き合いいただきましてありがとうございました！
すごいです！
私も少しずつ勉強していつかは自在に組めるように頑張りたいと思います。

回答No.4

AKARI0418

すいませんよく読んでいませんでした。
>(H列)がゼロ値でも空セルでもない場合のみ

'E列～L列のどれかひとつにデータがあるかを判別
UseFlag = False
For j = EColumn To LColumn
If Rng.Cells(i, j) <> vbNullString Then
UseFlag = True
Exit For
End If
Next j

この部分を
If Rng.Cells(i, HColumn ) <> vbNullString AND _
Rng.Cells(i, HColumn ) <> 0 Then
UseFlag = True
Exit For

と修正してください。
'H列
Const HColumn As Long = 8
を追加してください。

補足

AKARIO418様

TestBを使わせていただきました。
ほぼ完璧だったんですが、やはり(H列)がゼロか空セルは移動させないようにしなければならないんです。

回答#4を変更してみたんですけど、「NEXTに対応するForがありません」と表示されます。
どこがおかしいのかさっぱりです。

回答No.3

n-jun

＃２です。

＞(P列)がゼロ値でも空セルでもない下行に「値のみ」移動させたいです。
＞(H列がゼロ値か空セルの場合は移動さない）
と言う事はＨ列がゼロか空白の時は、Ｐ列がゼロや空白でもその行で良いと言う事ですか？

補足

n-jun様

はい。
(H列)がゼロか空白の時に移動なし、は
(P列)の条件よりも優先させたいです。
ですので(P列)がゼロか空セルでも(H列)は移動させません。

回答No.2

akari_0418

いかかでしょうか？

Sub TestB()
'E列
Const EColumn As Long = 5
'L列
Const LColumn As Long = 12
'P列
Const PColumn As Long = 16

Dim Rng As Range
Dim Movedat() As String
Dim counter As Integer
Dim Wcounter As Integer
Dim i As Long
Dim j As Long
Dim UseFlag As Boolean

'A列の1行目からP列のデータのある最終行までを取得する。
Set Rng = Range(Cells(1, 1), Range("$P$65536").End(xlUp))

'配列の初期化
ReDim Movedat(0)
counter = -1
Wcounter = -1

For i = 1 To Rng.Rows.Count

'E列～L列のどれかひとつにデータがあるかを判別
UseFlag = False
For j = EColumn To LColumn
If Rng.Cells(i, j) <> vbNullString Then
UseFlag = True
Exit For
End If
Next j

If UseFlag = True Then

'P列にデータがある場合は移動しない
If Rng.Cells(i, PColumn) = vbNullString Or _
Rng.Cells(i, PColumn) = 0 Then
counter = counter + 1
ReDim Preserve Movedat(counter)
'カンマ区切りで格納
For j = EColumn To LColumn
Movedat(counter) = Movedat(counter) & Rng.Cells(i, j)
If j <> LColumn Then
Movedat(counter) = Movedat(counter) & ","
End If
'セルクリア
Rng.Cells(i, j) = vbNullString
Next j
End If
ElseIf counter <> Wcounter Then
'P列にデータがある場合は書き出す
If Rng.Cells(i, PColumn) = vbNullString Or _
Rng.Cells(i, PColumn) = 0 Then
Else
Wcounter = Wcounter + 1
Dim field() As String
field = Split(Movedat(Wcounter), ",")
For j = EColumn To LColumn
Rng.Cells(i, j) = field(j - EColumn)
Next j
End If
End If
Next i

End Sub

回答No.1

n-jun

エクセル関数、またはVBA
http://okwave.jp/qa4687361.html
＞＃１の補足から、ワークシートのイベントに絡ませるのかとも思ったりしましたが、
＞Ａ列をどのタイミングで変化させたかったのでしょう。

移動とは１回だけ行えれば良いのでしょうか？
⇒あるいは編集後にＶＢＡを実行させて書き換えればいいのか。

それともＨ列の値の変化に応じて、移動イベントの発生が必要なのでしょうか？

補足

n-jun様

はい。
すべてのセルの値は変化せず、(H列)に値のある(E列:L列)行の移動はそれぞれ１回だけです。