只选择值为VBA的单元格

我有下面的代码并且工作正常，但我只想使用值复制单元格。我在中间有空白数据，因为我将删除这些数据也无法复制。只选择值为VBA的单元格

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

任何想法如何我可以更好地写它？用循环也许？谢谢！

来源

2016-11-22 Leandro Moreira

你看：http://stackoverflow.com/questions/5338725/copy-a-range-of-cells-and-only-select-cells-with-data或http://stackoverflow.com/questions/13351245/copy-a -range-of-cells-and-only-select-cells-with-data-and-just-the-value-not-the- 这两个都显示你可以使用的例子。 –

我认为这可以帮助！我可能没有正确检查。 –

我假设在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

来源

2016-11-22 19:43:25

这非常接近我想要的。你的作品会发生什么，当它再次出现时，空行仍然在下面，因为数据又在空白下面..所以我们可以说，它保持1空白4空白空白5，我想要的是粘贴数据在彼此之下1 4 5等 –

我已经更新了代码以分别存储每列的当前行。您只需在粘贴时增加它 - 因此它可以有效折叠空值上的每列。看看这是否有效。 –

我将与你的代码，这实际上试图选择范围开始。这是我在它之上构建：

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仅在第二列有值的情况下给出。
然后是两个范围的联合，并且在代码的末尾选择my_range。

来源

2016-11-22 19:56:05 Vityata

找到一种方法，做我想做的：至少是工作，我很牛逼的话，对你们可能看起来滑稽或坏，对我来说是很大的= 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

来源

2016-11-22 20:40:07

只选择值为VBA的单元格

回答

相关问题