Excel VBA中 - 基於空白另一列

我有一個excel工作表，像這樣的變體去除細胞：Excel VBA中 - 基於空白另一列

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中的同一行）是空白的。然後我想該變體複製到一個新的列（即山坳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

來源

2011-06-14 diggy

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

來源

2011-06-14 01:37:00 Jay

挑剔的注意事項：aCell和B細胞變異體在上面的聲明。應該像_Dim一個量程，b以距離，c作爲Range_ – ray 2011-06-14 13:31:45

@ray你是對的 - 我認爲它的工作原理一樣，在VB（不VBA）。 – Jay 2011-06-14 14:21:36

嘗試：

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做到這一點。

來源

2011-06-14 02:20:18 Reafidy

找到更好的辦法：destsheet.Range（destcells（UBound函數（destcells））＆「：」＆左（destcells（UBound函數（destcells）），1）和「65536」）SpecialCells（xlCellTypeBlanks）.EntireRow.Delete – diggy 2011-06-14 02:44:25

是什麼讓。你說那更好？我不想設定unnessecary變量和使用rows.count允許Excel中DIFF版本。 – Reafidy 2011-06-14 03:28:06

我個人認爲，你使這個簡單的工作更難，但這裏是如何做到這一點，你想要的方式：

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

來源

2011-06-14 03:08:17

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

來源

2011-06-14 14:54:41

Excel VBA中 - 基於空白另一列

回答

相關問題