只选择值为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
任何想法如何我可以更好地写它?用循环也许?谢谢!
我假设在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
这非常接近我想要的。你的作品会发生什么,当它再次出现时,空行仍然在下面,因为数据又在空白下面..所以我们可以说,它保持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
。
找到一种方法,做我想做的:至少是工作,我很牛逼的话,对你们可能看起来滑稽或坏,对我来说是很大的= 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
你看:http://*.com/questions/5338725/copy-a-range-of-cells-and-only-select-cells-with-data或http://*.com/questions/13351245/copy-a -range-of-cells-and-only-select-cells-with-data-and-just-the-value-not-the- 这两个都显示你可以使用的例子。 –
我认为这可以帮助!我可能没有正确检查。 –