値が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 

どうすればいいと思いますか？ループかもしれない？ありがとう！

Answer 1

Range(ActiveCell, Cells(LastRow, AC)).Selectの後に、ブランクセルを無視してコピーする領域が選択されているとします。

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

私は実際に範囲を選択しようとするあなたのコードで始まります。それについて移動するための一つの方法は、彼らが空ではなく、それらをコピーするかどうかを確認、Selection内のすべてのセルを反復することです。これは私がそれに基づいて構築したものである：

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は、2番目の列に値がある場合にのみ与えられます。
• 次に、両方の範囲の和集合があり、コードの最後にmy_rangeが選択されています。私がやりたいする方法を発見し

Answer 3

：少なくとも働いているあなたたちは私のために、面白いか悪いかに見えるかもしれませんが、私は、そうニュービーだが大きい= 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