セルが空の場合は、隣接する列の値を上の行に移動します。

Question

データセットがあり、列Aに空のセルがいくつかあります。空のセルがある場合、私は上記の行にB列の値を移動し、B列の値をクリーンアップしたいと思います。これは、列Aに空のセルが1つしかない場合しかし、列Aに2つ以上の空のセルがある場合（これは、列Bの値を列Aが空でない行（この場合は上の行ではない）に移動することを意味します）には機能しませんでした。それは他の状況で動作するように誰も私はコードを微調整するのに役立つことができますか？ありがとうございました。

私のコードは次のとおりです。

Sub MoveToRow() 
Dim i As Integer 
For i = 1 To 10 


If IsEmpty(Sheets("Sheet1").Range("A" & i)) = True Then 
    Sheets("Sheet1").Range("B" & i).Offset(-1, 0) = Range("B" & i).Offset(-1, 0) & "/" & Range("B" & i) 
    Sheets("Sheet1").Range("B" & i).Value = Empty 

End If 

Next i 

End Sub 

データセット-後

Sunday work1 
     work2 
Monday work3 
Tuesday work4 
     work5 
Wednesday work6 
Thursday work7 
Friday work8 

データセット-前

Sunday work1/work2 

Monday work3 
Tuesday work4/work5 

Wednesday work6 
Thursday work7 
Friday work8 

Dataset-は動作しませんでした

（下の2つの空のセルがあるので、日曜日）

Sunday work1 
     work2 
     work3 
Monday work4 
Tuesday work5 
     work6 
Wednesday work7 
Thursday work8 
Friday work9 

Dataset-それは

Sunday work1/work2/work3 


Monday work4 
Tuesday work5/work6 

Wednesday work7 
Thursday work8 
Friday work9 

Answer 1

はこの試してみて動作するかどうか：

Option Explicit 

Sub MoveToRow() 

Dim i As Integer 
Dim ws As Worksheet 
Dim r As Range 
Dim count As Integer 

Application.ScreenUpdating = False 

Set ws = Worksheets("Sheet1") 
For Each r In ws.Range(Cells(1, 1), Cells(Rows.count, 1).End(xlUp)) 
    If IsEmpty(r) Then 
     count = count + 1 
     With ws.Range(r.address) 
      .Offset(-count, 1) = .Offset(-count, 1) & "/" & .Offset(0, 1) 
      .Offset(0, 1).ClearContents 
     End With 
    Else 
     count = 0 
    End If 
Next r 

Application.ScreenUpdating = True 

End Sub 

はまた、あなたは好きなら余っ空の行を削除するには、そこにいくつかのコードを追加することができます。しかし、私はあなたにそれを任せます。 :-)