excel vba - 從基於另一列空白的變體中刪除單元格

Question

我有一張像這樣的 excel 表：

HEADING <--A1           HEADING  <-- this is B1
dhg                     kfdsl
56                      fdjgnm
hgf                     fdkj
tr
465                     gdfkj

gdf53
ry                      4353
654                     djk

354 <-- a12                      blah     <-- this is B12

我正在嘗試將 A 列中的單元格范圍放入一個變體中，如果 B 列中的單元格（對於 A 列中的同一行）為空白，則從該變體中刪除任何數據。 然后我想將該變體復制到一個新列（即 col c）

所以我的預期結果是：

HEADING <--C1           
dhg                     
56                      
hgf                     
465                     
ry                      
654                     
354 <-- C8          

這是我到目前為止的代碼：

    Dim varData As Variant
    Dim p As Long

varData = originsheet.Range("B2:B12")

                For p = LBound(varData, 1) To UBound(varData, 1)                   
                    If IsEmpty(varData(p, 1)) Then
                        remove somehow
                    End If
                Next p

Answer 1

Dim bRange As range
Set bRange = originsheet.range("B2:B12")

Dim aCell, bCell, cCell As range
Set cCell = originsheet.Cells(2, 3) 'C2
For Each bCell In bRange
    If bCell.Text <> "" Then
        Set aCell = originsheet.Cells(bCell.Row, 1)
        cCell.Value2 = aCell.Value2
        Set cCell = originsheet.Cells(cCell.Row + 1, 3)
    End If
Next bCell

Answer 2

嘗試：

  With ActiveSheet.UsedRange
        .Cells(2, "C").Resize(.Rows.Count).Value = Cells(2, "A").Resize(.Rows.Count).Value
        .Cells(2, "B").Resize(.Rows.Count).SpecialCells(xlCellTypeBlanks).Offset(, 1).Delete shift:=xlUp
  End With

編輯：

這個更好：

With Range("A2", Cells(Rows.Count, "A").End(xlUp))
   Cells(2, "C").Resize(.Rows.Count).Value = .Value
   .Offset(, 1).SpecialCells(xlCellTypeBlanks).Offset(, 1).Delete shift:=xlUp
End With

您也可以使用高級過濾器而不使用 VBA。

Answer 3

就個人而言，我認為您使這項簡單的工作變得更加困難，但這是您想要的方式：

Public Sub Test()

Dim Arange As Variant, Brange As Variant, Crange() As Variant
Dim i As Integer, j As Integer

Arange = Range("A2:A12")
Acount = Application.WorksheetFunction.CountA(Range("B2:B12"))
Brange = Range("B2:B12")
j = 1
ReDim Crange(1 To Acount, 1 To 1)
For i = 1 To UBound(Arange)
  If Brange(i, 1) <> "" Then
    Crange(j, 1) = Arange(i, 1)
    j = j + 1
  End If
Next i

Range("C2:C" & j) = Crange
End Sub

Answer 4

Sub Main()

    Dim rValues As Range
    Dim vaIn As Variant
    Dim vaTest As Variant
    Dim aOut() As Variant
    Dim i As Long
    Dim lCnt As Long

    Set rValues = Sheet1.Range("A2:A12")
    vaIn = rValues.Value
    vaTest = rValues.Offset(, 1).Value
    ReDim aOut(1 To Application.WorksheetFunction.CountA(rValues.Offset(, 1)), 1 To 1)

    For i = LBound(vaIn, 1) To UBound(vaIn, 1)
        If Len(vaTest(i, 1)) <> 0 Then
            lCnt = lCnt + 1
            aOut(lCnt, 1) = vaIn(i, 1)
        End If
    Next i

    Sheet1.Range("C2").Resize(UBound(aOut, 1)).Value = aOut

End Sub