excel vba-从基于另一列中空白的变量中删除单元格

如何解决excel vba-从基于另一列中空白的变量中删除单元格

| 我有一个像这样的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

    

解决方法

        

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

    ,        就个人而言，我认为您使这项简单工作变得更加困难，但是以下是您想要的方式：

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

    ,        尝试：

  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。     ,        

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