Выбор только ячеек со значением 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

Начну с кодом, который на самом деле пытается выбрать диапазоны. Это то, что я построил на нем:

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 выбран в конце кода.

Answer 3

Найден способ сделать то, что я хочу: По крайней мере, работает, я Newby так, для вас, ребята, может показаться смешной или плохо, для меня велик = 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