Excel VBA データの入っているセルの取り出し

Question

Excel2007使用です。
大きなセル範囲の中にデータが点在している場合に、そのデータを一か所にまとめるマクロを作りたいです。セル範囲は決まっています（A1:Q100）。最終的には隣のセルの1列にまとめたいです。

以下のようなマクロを作ってみましたが、いずれも作動しませんでした（エラーメッセージも出ず）
NullをEmptyに変えてみても同じでした。
（ややこしいですが、アクティブセルはSheet2、Sheet1へ貼り付けたい）

（とりあえずシート内で列上部にまとめようとした）
Dim myRange As Range
For Each myRange In Range("A1:Q100")
If myRange.Value = Null Then
myRange.Delete xlShiftUp
End If
Next myRange
End Sub

（1行1列ずつの参照をループさせて「空白でない」セルを切り取り-貼り付けさせようとした）
Worksheets("sheet2").Activate
Dim Gyou As Integer
Dim Retsu As Integer
For Gyou = 1 To 100
  For Retsu = 1 To 17
    If Cells(Gyou, Retsu).Value = Not Null Then
       Cells(Gyou, Retsu).Cut Destination:=Worksheets("sheet1").Cells(5, 2)
    End If
  Next Retsu
Next Gyou
End Sub

また、以下のマクロは、実行すると現状のままSheet1のE列以降に移るだけで、データのあるセルだけがまとまるという状態にはなりません。
Range("A1:Q100").SpecialCells(xlCellTypeVisible).Cut Destination:=Worksheets("Sheet3").Range("E1")
End Sub

以下は某サイトで、まさに「空白セルを削除しデータの入ってるセルを上詰めにする」というマクロが紹介されていたので、加工してやってみましたが、「RangeクラスのDeleteメソッドが失敗しました」という実行時エラーが出てできませんでした。
Dim WS As Worksheet
Dim myRng As Range
Dim Lrow As Long
Set WS = Worksheets("Sheet1")
Lrow = WS.Range("A" & CStr(Rows.Count)).End(xlUp).Row
Set myRng = WS.Range("A1:A" & CStr(Lrow))
myRng.SpecialCells(xlCellTypeBlanks).Delete xlShiftUp
End Sub

データの入っているセルだけを取り出して一つの列にまとめたいのですが、どうしたらいいのでしょうか。

xls88 · Accepted Answer

A1:Q100には、データが入力されたセルと、何も入力されていない空白のセルのみですか？
数式があるとか、空白に見えるセルは無いという事で良かったですか？

データセルを同じシートのS1以下1列に書き出してみました。

Dim rng As Range
    Dim n As Integer
    Dim i As Integer
    
    Set rng = Range("A1:Q100")
    For i = 1 To rng.Columns.Count
        On Error Resume Next
        With rng.Columns(i).SpecialCells(xlCellTypeConstants, 23)
            .Copy Range("S1").Offset(n)
            n = n + .Count
        End With
        On Error GoTo 0
    Next i

tom04 · Answer

こんにちは！
すでに回答は色々出ていますので、参考程度で・・・

関数での方法は
Sheet2のA1セルに
=IF(COUNTA(Sheet1!A$1:A$100)<ROW(A1),"",INDEX(Sheet1!A$1:A$100,SMALL(IF(Sheet1!A$1:A$100<>"",ROW($A$1:$A$100)),ROW(A1))))

これは配列数式になりますので、この画面からコピー＆ペーストしただけではエラーになると思います。
貼り付け後、F2キーを押す、またはA1セルをダブルクリック、または数式バー内で一度クリックします。
編集可能になりますので、Shift+Ctrlキーを押しながらEnterキーで確定します。
数式の前後に｛　｝マークが入り配列数式になります。
これを列方向と行方向にオートフィルでコピーすると、空白が無視され上詰めになると思います。

VBAでは一例ですが
まずSheet1すべてをコピー→Sheet2に貼り付けします。そしてSheet2のシート見出し上で右クリックし
↓のコードを貼り付けマクロを実行してみてください。

Sub test()
    Dim i, j As Long
    For i = 100 To 1 Step -1
    For j = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
    If Cells(i, j) = "" Then
        Cells(i, j).Delete (xlUp)
    End If
    Next j
    Next i
End Sub

A列のデータ行が他の列以上であれば、↓のコードで最終行を取得して
もう少し短時間でマクロが実行できると思います。

Sub test2()
    Dim i, j As Long
    For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
    For j = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
    If Cells(i, j) = "" Then
        Cells(i, j).Delete (xlUp)
    End If
    Next j
    Next i
End Sub

どうも長々と失礼しました。m(__)m

imogasi · Answer

何で複雑に考える必要があるのかな
Sub test01()
k = 2
Dim myRange As Range
For Each myRange In Range("A1:Q100")
If myRange = "" Then
Else
Cells(k, "z") = myRange
k = k + 1
End If
Next myRange
End Sub
でZ列に縦１列にデータが集るよ。
ただ空白のセルの質問者が込めている意味は明白で無いが。
関数の結果が""であるものはこれで察知できるはず。Cells(k, "z") はCells(k, "z").Valueの略で
来歴によらず、「セルの値」を見るものだから。
""、NULL、Emptyについては別に勉強して。またはそれに特化して質問してみたら。
WEBで「エクセルVBA　NULL」「エクセルVBA　Empty」で照会。
例えばNULLではhttp://oshiete.homes.jp/qa2750911.html
のWendy02さんの説明を読んでみてください.
その中に「私は、数年、VBAを書いておりますが、Null値を積極的に使った経験はありません。」と書いておられますが、私もこの１０年間の回答で、Null,Emptyを意識しなくても済みましたが。

ka_na_de · Answer

#2です。
以前のコードでは=""などの文字数０のデータを除けなかったので改良しました。
値（定数）、および、数式で計算された値を一列に並べます。

Sheet2　の　A1：Q100　のデータを
Sheet1　の　E列に並べるように作りました。

注）Sheet1　の　E1セルに見出しがある前提です。
　　Sheet2　の　S列を作業列として使います。

Sub test2()
　　Dim Ws1 As Worksheet
　　Dim Ws2 As Worksheet
　　Dim myRange As Range
　　Dim i As Long

Set Ws1 = Worksheets("Sheet1")
　　Set Ws2 = Worksheets("Sheet2")
　　Set myRange = Ws2.Range("A1:Q100")

Ws2.Range("S1").Value = Ws1.Range("E1").Value

For i = 1 To myRange.Columns.Count
　　　　myRange.Resize(, 1).Offset(, i - 1).Copy
　　　　Ws2.Range("S" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
　　Next i
　　　　
　　With Ws2.Columns("S")
　　　　If Ws2.AutoFilterMode Then Ws2.AutoFilterMode = False
　　　　.AutoFilter Field:=1, Criteria1:="<>"
　　　　.Copy Destination:=Ws1.Range("E1")
　　　　.Delete
　　End With
　　
　　Set Ws1 = Nothing
　　Set Ws2 = Nothing
　　Set myRange = Nothing
End Sub

ka_na_de · Answer

Sheet2　の　A1：Q100　のデータを
Sheet1　の　E列に並べるように作りました。

Sheet1　の　E1セルに見出しがあればE2以降に並びます。

Sub test1()
　　Dim Ws1 As Worksheet
　　Dim Ws2 As Worksheet
　　Dim myRange As Range
　　Dim i As Long

Set Ws1 = Worksheets("Sheet1")
　　Set Ws2 = Worksheets("Sheet2")
　　Set myRange = Ws2.Range("A1:Q100")

For i = 1 To myRange.Columns.Count
　　　　myRange.Resize(, 1).Offset(, i - 1).Copy _
　　　　　　　　Destination:=Ws1.Range("E" & Rows.Count).End(xlUp).Offset(1)
　　Next i
　　
　　Ws1.Columns("E").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
　　
　　Set Ws1 = Nothing
　　Set Ws2 = Nothing
　　Set myRange = Nothing
End Sub

KURUMITO · Answer

取り合えず次のようにすることで行を詰めることができますね。ご参考までに。

For RowPos = 1 To 100
If WorksheetFunction.CountBlank(Range(Range("A" & RowPos), Range("D" & RowPos))) = 4 Then
Rows(RowPos).Delete xlShiftUp
End If
Next

Excel VBA データの入っているセルの取り出し

A1:Q100には、データが入力されたセルと、何も入力されていない空白のセルのみですか？

この回答への補足

こんにちは！

何で複雑に考える必要があるのかな

#2です。

Sheet2 の A1：Q100 のデータを

取り合えず次のようにすることで行を詰めることができますね。

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

Sheet2　の　A1：Q100　のデータを