将单元格向左移动而不影响其自己的列

Question

COLS : NO |   | B | C |   | D
  01 : 1  |   | 8 | 3 |   | 2
  02 :    |   |   | 4 |   | 
  03 :    |   |   |   |   |
  04 : 2  |   | 5 | 2 |   | 6

如何将值向左移动并删除空行，但将值保留在其自己的列中？目标是：

COLS : NO | B | C | D
  01 : 1  | 8 | 3 | 2
  02 :    |   | 4 | 
  03 : 2  | 5 | 2 | 6
  04 :    |   |   |

C2中的数字4应该保留在其自己的列中（这是C列中记录1的额外值）。我现在得到的不是我想要的：

COLS : NO | B | C | D
  01 : 1  | 8 | 3 | 2
  02 : 4  |   |   | 
  03 : 2  | 5 | 2 | 6
  04 :    |   |   |

Answer 1

我希望得到这个结果：

Before

After

Answer 2

尝试

Sub test2()
    Dim Ws As Worksheet
    Dim rngDB As Range, rng As Range
    Dim vDB As Variant, vR() As Variant
    Dim i As Long, r As Long
    Dim n As Long, c As Integer, j As Integer
    Dim k As Integer
    Dim vC(), vRow()

    Set Ws = ActiveSheet
    Set rngDB = Ws.UsedRange
    vDB = rngDB
    r = UBound(vDB, 1)
    c = UBound(vDB, 2)

    For i = 1 To r
        Set rng = rngDB.Rows(i)
        If Not WorksheetFunction.CountA(rng) = 0 Then
            n = n + 1
            ReDim Preserve vRow(1 To n)
            vRow(n) = i
        End If
    Next i
    For i = 1 To c
        Set rng = rngDB.Columns(i)
        If Not WorksheetFunction.CountA(rng) = 0 Then
            k = k + 1
            ReDim Preserve vC(1 To k)
            vC(k) = i
        End If
    Next i
    ReDim Preserve vR(1 To n, 1 To k)
    For i = 1 To n
        For j = 1 To k
            vR(i, j) = vDB(vRow(i), vC(j))
        Next j
    Next i

    Sheets.Add
    Range("a1").Resize(n, k) = vR
End Sub



Sub test()
    Dim Ws As Worksheet
    Dim rngDB As Range, rng As Range
    Dim vDB As Variant, vR() As Variant
    Dim i As Long, r As Long
    Dim n As Long, c As Integer, j As Integer
    Dim k As Integer

    Set Ws = ActiveSheet
    Set rngDB = Ws.UsedRange
    vDB = rngDB
    r = UBound(vDB, 1)
    c = UBound(vDB, 2)
    ReDim vR(1 To r, 1 To c)
    For i = 1 To r
        Set rng = rngDB.Rows(i)
        If WorksheetFunction.CountA(rng) Then
            n = n + 1
            k = 0
            For j = 1 To c
                If vDB(i, j) <> "" Then
                    k = k + 1
                    vR(n, k) = vDB(i, j)
                End If
            Next j
        End If
    Next i
    'rngDB = vR  '<~~~  Use this to write on the same sheet.
    Sheets.Add
    Range("a1").Resize(r, c) = vR
End Sub

之前

之后