Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1588 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【73284】罫線の下にデータを移動したい ブーチー 12/12/17(月) 17:50 質問[未読]
【73285】Re:罫線の下にデータを移動したい UO3 12/12/17(月) 20:09 発言[未読]
【73294】Re:罫線の下にデータを移動したい ブーチー 12/12/18(火) 8:09 お礼[未読]
【73295】Re:罫線の下にデータを移動したい ブーチー 12/12/18(火) 9:35 質問[未読]
【73297】Re:罫線の下にデータを移動したい UO3 12/12/18(火) 12:27 発言[未読]
【73299】Re:罫線の下にデータを移動したい ブーチー 12/12/18(火) 15:30 お礼[未読]
【73284】罫線の下にデータを移動したい
質問  ブーチー  - 12/12/17(月) 17:50 -
引用なし
パスワード
   次のようなデータが有るときに、罫線の下にデータを移動したいです。
罫線の太さは決まっていません。

1番上のデータがあるセルを選択した状態からﾏｸﾛを実行したいと思います。
罫線の間隔も決まってはいません。

最終データがあるところまで処理したいです。

ﾏｸﾛ実行前
−−−−−−−−−−−

あ　　←　選択されているセル
−−−−−−−−−−−
い

−−−−−−−−−−−


う
−−−−−−−−−−−


え


−−−−−−−−−−−

ﾏｸﾛ実行後
−−−−−−−−−−−
あ

−−−−−−−−−−−
い

−−−−−−−−−−−
う


−−−−−−−−−−−
え


−−−−−−−−−−−
【73285】Re:罫線の下にデータを移動したい
発言  UO3  - 12/12/17(月) 20:09 -
引用なし
パスワード
   ▼ブーチー さん：

こんばんは

"あ"が選択されていたとき、"あ"から下を調べると、"あ"を移動すべき罫線が
上の方にあるので、以下のコードでは、選択されたセルの列の１行目から
その列のデータ最終行までを対象にします。

Sub Sample()
　　Dim c As Range
　　Dim a As Range
　　
　　For Each c In Range(Selection(1).EntireColumn.Cells(1), Selection(1).EntireColumn.Cells(Rows.Count).End(xlUp))
　　　　If c.Borders(xlEdgeTop).LineStyle <> xlNone Then Set a = c
　　　　If Len(c.Value) > 0 And Not a Is Nothing Then
　　　　　　If a.Address <> c.Address Then
　　　　　　　　a.Value = c.Value
　　　　　　　　c.ClearContents
　　　　　　End If
　　　　End If
　　Next
　　
End Sub
【73294】Re:罫線の下にデータを移動したい
お礼  ブーチー  - 12/12/18(火) 8:09 -
引用なし
パスワード
   ▼UO3 さん　回答ありがとうございます。
シンプルなコードで実現できて、たいへんうれしいです。
【73295】Re:罫線の下にデータを移動したい
質問  ブーチー  - 12/12/18(火) 9:35 -
引用なし
パスワード
   ▼UO3 さん　
自分で改良しようと思ったのですが、まだまだ力不足で出来ません。
次のように文字が２つ以上あり、連続していたり、離れていたりしても、罫線の下に並べたいのですが、どうすれば良いのかお教え願います。


ﾏｸﾛ実行前
−−−−−−−−−−−

あ　　←　選択されているセル
−−−−−−−−−−−
い

−−−−−−−−−−−

う
う１
−−−−−−−−−−−


え

え１
−−−−−−−−−−−

ﾏｸﾛ実行後
−−−−−−−−−−−
あ

−−−−−−−−−−−
い

−−−−−−−−−−−
う
う１

−−−−−−−−−−−
え
え１

−−−−−−−−−−−
【73297】Re:罫線の下にデータを移動したい
発言  UO3  - 12/12/18(火) 12:27 -
引用なし
パスワード
   ▼ブーチー さん：

以下ではいかがでしょう


Sub Sample2()
　　Dim c As Range
　　Dim a As Range
　
　　For Each c In Range(Selection(1).EntireColumn.Cells(1), Selection(1).EntireColumn.Cells(Rows.Count).End(xlUp))
　　　　If c.Borders(xlEdgeTop).LineStyle <> xlNone Then Set a = c
　　　　If Len(c.Value) > 0 And Not a Is Nothing Then
　　　　　　If a.Address <> c.Address Then
　　　　　　　　a.Value = c.Value
　　　　　　　　c.ClearContents
　　　　　　End If
　　　　　　Set a = a.Offset(1)
　　　　End If
　　Next
　
End Sub
【73299】Re:罫線の下にデータを移動したい
お礼  ブーチー  - 12/12/18(火) 15:30 -
引用なし
パスワード
   ▼UO3 さん　ありがとうございます。

期待通りの動きをしました。
すごいと思いました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1588 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free