仅选择具有值VBA的单元格

Question

我有下面的代码，工作正常，但我只想复制带有值的单元格。我在中间有空白数据，因为我将删除复制它们没有意义。

Sub FindAgain()
'
' FindAgain Macro
'
    Dim Ws As Worksheet
    Dim LastRow As Long

    AC = ActiveCell.Column
    Set Ws = Worksheets("Sheet1")
    LastRow = Ws.Cells(Rows.Count, "B").End(xlUp).Row
    Cells.Find(What:="Scenario", After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Offset(1, 0).Select
    Range(ActiveCell, Cells(LastRow, AC)).Select

End Sub

知道如何更好地写它吗？有Loop可能吗？谢谢！

Answer 1

我假设在Range(ActiveCell, Cells(LastRow, AC)).Select之后，您会看到要复制的区域，忽略空白单元格。一种方法是迭代Selection中的所有单元格，检查它们是否为空并复制它们：

Dim c As Range
Dim i As Long

' store current row for every column separately
Dim arrRowInCol() As Long
ReDim arrRowInCol(Selection.Column To Selection.Column + Selection.Columns.Count - 1)
For i = LBound(arrRowInCol) To UBound(arrRowInCol)
    ' init the first row for each column
    arrRowInCol(i) = Selection.Row
Next i

For Each c In Selection
    If Len(Trim(c)) <> 0 Then
        c.Copy Destination:=Sheets("Sheet2").Cells(arrRowInCol(c.Column), c.Column)
        arrRowInCol(c.Column) = arrRowInCol(c.Column) + 1
    End If
Next c

Answer 2

找到一种方法来做我想要的事情：至少是工作，我是新手，因为你们看起来好笑或者坏，对我来说很棒= D

Sub FindAgain()
'
' FindAgain Macro
'
Dim Ws As Worksheet
Dim LastRow As Long
Dim c As Range
Dim i As Integer
Dim j As Integer

AC = ActiveCell.Column
Set Ws = Worksheets("Sheet1")
LastRow = Ws.Cells(Rows.Count, "B").End(xlUp).Row
i = 15
j = 7
Cells.Find(What:="Scenario", After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
ActiveCell.Offset(1, 0).Select
Range(ActiveCell, Cells(LastRow, AC)).Select

For Each c In Selection
    If Len(Trim(c)) <> "" Then
        c.Copy Destination:=Sheets("Sheet1").Cells(i, j)
    End If

    If c = "" Then
    i = i
    Else
    i = i + 1
    End If
    j = j

Next c

End Sub

Answer 3

我将从你的代码开始，它实际上试图选择范围。这就是我所建立的：

Dictionary

它适用于这样的场景：

它的工作原理如下：

• 我们宣布两个范围。
• 范围Option Explicit Public Sub FindMe() Dim my_range As Range Dim temp_range As Range Dim l_counter As Long Dim my_list As Object Dim l_counter_start As Long Set my_list = New Collection l_counter_start = Cells.Find(What:="Scenario", After:=ActiveCell, LookIn:=xlValues, LookAt _ :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _ False, SearchFormat:=False).Row + 1 For l_counter = l_counter_start To Worksheets("sheet1").Cells(Rows.Count, "B").End(xlUp).Row If Cells(l_counter, 2) <> "" Then my_list.Add (l_counter) Next l_counter For l_counter = 1 To my_list.Count Set temp_range = Range(Cells(my_list(l_counter), 2), Cells(my_list(l_counter), 4)) If my_range Is Nothing Then Set my_range = temp_range Else Set my_range = Union(my_range, temp_range) End If Next l_counter my_range.Select End Sub 是最后选择的范围。
• 如果第二列中有值，则仅给出范围my_range。
• 然后是两个范围的并集，并且在代码末尾选择了temp_range。