Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
770 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【78415】範囲内のセルを左詰め移動するマクロ ひでとし 16/9/18(日) 10:07 質問[未読]
【78416】Re:範囲内のセルを左詰め移動するマクロ ひでとし 16/9/18(日) 10:11 発言[未読]
【78417】Re:範囲内のセルを左詰め移動するマクロ ひでとし 16/9/18(日) 10:15 発言[未読]
【78418】Re:範囲内のセルを左詰め移動するマクロ β 16/9/18(日) 10:54 発言[未読]
【78420】Re:範囲内のセルを左詰め移動するマクロ β 16/9/18(日) 11:44 発言[未読]
【78421】Re:範囲内のセルを左詰め移動するマクロ ひでとし 16/9/18(日) 12:12 お礼[未読]
【78423】Re:範囲内のセルを左詰め移動するマクロ β 16/9/18(日) 13:59 発言[未読]
【78425】Re:範囲内のセルを左詰め移動するマクロ ひでとし 16/9/18(日) 16:06 お礼[未読]
【78415】範囲内のセルを左詰め移動するマクロ
質問  ひでとし E-MAIL  - 16/9/18(日) 10:07 -
引用なし
パスワード
   初心者で他のHPも調べてみたのですが、わからないので教えて下さい。

処理前のデータ
ABCDEFGHIJKLMN
1*** * * * ** *
2　* ** ** * *
3* * * **　* **
4 **　 **　 **

処理後のデータ
ABCDEFGHIJKLMN
1*** * * * ** *
2　*****　 * *
3* ****　　* **
4 **　 **　 **

処理したいのは次の通りです。
マウスで任意の範囲を選びます。上の例ではD2:J3。その範囲内の空白セルを詰めて左詰めしたいのです。

Sub test()
Dim r As Range
For Each r In Selection.Cells
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete shift:=xlToLeft
Next r
End Sub

を作ってみたのですが、左寄せ削除のため指定範囲外の行全体が左に動きます。範囲内のみを左詰めするマクロを教えて下さい。よろしくお願いします。
【78416】Re:範囲内のセルを左詰め移動するマクロ
発言  ひでとし E-MAIL  - 16/9/18(日) 10:11 -
引用なし
パスワード
   質問をアップしたら列表示がずれていたのでもう一度アップします。
申し訳ありません。
処理前のデータ
0ABCDEFGHIJKLMN
1*** * * * ** *
2　* ** ** * *
3* * * **　* **
4 **　 **　 **

処理後のデータ
0ABCDEFGHIJKLMN
1*** * * * ** *
2　*****　 * *
3* ****　　* **
4 **　 **　 **
【78417】Re:範囲内のセルを左詰め移動するマクロ
発言  ひでとし E-MAIL  - 16/9/18(日) 10:15 -
引用なし
パスワード
   今度は列のアルファベットがいつの間にか全角になっておりまたずれている。
もーいや！
【78418】Re:範囲内のセルを左詰め移動するマクロ
発言  β  - 16/9/18(日) 10:54 -
引用なし
パスワード
   ▼ひでとし さん：

インチキ（？）で、作業シート "work" を使います。
なお、削除そのものはループなしでＯＫです。
また、選択領域に空白セルがなかった場合のエラー回避をしています。

（作業シートなしで処理するなら、配列に取り込み、配列内でループ処理をして書き戻すということもできます）


Sub Sample()
　　
　　With Sheets("work")
　　　　.Cells.Clear
　　　　Selection.Copy .Range("A1")
　　　　On Error Resume Next
　　　　.Range("A1", .UsedRange).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
　　　　On Error GoTo 0
　　　　.Range("A1", .UsedRange).Copy Selection
　　End With

End Sub
【78420】Re:範囲内のセルを左詰め移動するマクロ
発言  β  - 16/9/18(日) 11:44 -
引用なし
パスワード
   ▼ひでとし さん：

作業シートを使わない、まともな処理（？）案。

Sub Sample2()
　　Dim r As Range
　　Dim ad As String
　　Dim w As Variant
　　Dim n As Long
　　
　　n = Selection.Columns.Count
　　
　　For Each r In Selection.Rows
　　　　If WorksheetFunction.CountA(r) > 0 Then
　　　　　　ad = r.Address
　　　　　　w = Filter(Evaluate("IF(" & ad & "="""",CHAR(2)," & ad & ")"), Chr(2), False)
　　　　　　ReDim Preserve w(0 To n - 1)
　　　　　　r.Value = w
　　　　End If
　　Next
　　
End Sub
【78421】Re:範囲内のセルを左詰め移動するマクロ
お礼  ひでとし E-MAIL  - 16/9/18(日) 12:12 -
引用なし
パスワード
   さらに素晴らしいマクロです。有り難うございました。
実は、ヤフー知恵袋にも質問しました。まだ回答は付いていませんが、もし時間があればヤフーでも回答してもらえませんか。ヤフーを見ている人にも共有してほしいです。もし無理ならば、ヤフーでの質問は取り下げようと思います。
毎回手作業で１時間掛かるところを１秒で処理してくれます。大変助かりました。
【78423】Re:範囲内のセルを左詰め移動するマクロ
発言  β  - 16/9/18(日) 13:59 -
引用なし
パスワード
   ▼ひでとし さん：

知恵袋のほうは、どこそこで回答があって解決した。
ちなみに回答コードは、こうだったということで、ひでとしさんがクローズしてください。

私がアップしたコードを貼り付けてもらってもかまいません。
【78425】Re:範囲内のセルを左詰め移動するマクロ
お礼  ひでとし E-MAIL  - 16/9/18(日) 16:06 -
引用なし
パスワード
   ヤフー知恵袋の方に貼り付けさせてもらいました。
ありがとうございます。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
770 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free