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 (для той же строки в столбце А) пусто.Затем я хочу скопировать этот вариант в новый столбец (т.е. столбец 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

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

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

Попробуйте:

  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.