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
答
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
答
尝试:
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做到这一点。
答
我个人认为,你使这个简单的工作更难,但这里是如何做到这一点,你想要的方式:
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
答
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
挑剔的注意事项:aCell和B细胞变异体在上面的声明。应该像_Dim一个量程,b以距离,c作为Range_ – ray 2011-06-14 13:31:45
@ray你是对的 - 我认为它的工作原理一样,在VB(不VBA)。 – Jay 2011-06-14 14:21:36