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

excel vba - 根据另一列中的空白从变体中删除单元格

4 个答案: