Excel VBA質問箱 IV

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

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


38179 / 76732 ←次へ | 前へ→

【43696】Re:空白のセルに自動で貼り付け
発言  かみちゃん  - 06/10/23(月) 12:00 -

引用なし
パスワード
   こんにちは。かみちゃん です。

>私もこのマクロが欲しくて検索したらこれがひっかかりました。

[#43665]で一応解決済みのようなのですが。

> 対象となる列(この場合("A1",LastCell)ですが)をマクロ実行前に指定する方法はありませんか?

以下のような感じでできます。
For 〜 Next の内側の記述は、変更ありません。
InputBoxが表示されたら、対象とする列を選択してください。
なお、選択した一番左の1列だけを処理します。(複数列には未対応)

Sub Sample1_1()
 Dim rngColumns As Range
 Dim LastCell As Range
 Dim c As Range
 Dim valData
 
 On Error Resume Next
 Set rngColumns = Application.InputBox("対象列を選択してください", Type:=8)
 If Err.Number <> 0 Then Exit Sub
 On Error GoTo 0
 
 Set LastCell = Cells(Rows.Count, rngColumns.Columns(1).Column).End(xlUp)

 For Each c In Range(Cells(1, LastCell.Column), LastCell)
  If c.Value = "" Then
   c.Value = valData
  Else
   valData = c.Value
  End If
 Next
 MsgBox "終了!!"
End Sub

Sub Sample2_1()
 Dim rngColumns As Range
 Dim LastCell As Range
 Dim c As Range

 On Error Resume Next
 Set rngColumns = Application.InputBox("対象列を選択してください", Type:=8)
 If Err.Number <> 0 Then Exit Sub
 On Error GoTo 0
 
 Set LastCell = Cells(Rows.Count, rngColumns.Columns(1).Column).End(xlUp)
 For Each c In Range(Cells(1, LastCell.Column), LastCell).SpecialCells(xlCellTypeConstants, 3)
  If c.Address <> LastCell.Address Then
   Range(c, c.End(xlDown).Offset(-1)).Value = c.Value
  End If
 Next
 MsgBox "終了!!"
End Sub

0 hits

【43661】空白のセルに自動で貼り付け 加藤 06/10/22(日) 10:53 回答
【43662】Re:空白のセルに自動で貼り付け かみちゃん 06/10/22(日) 11:04 発言
【43693】Re:空白のセルに自動で貼り付け Help me!! 06/10/23(月) 11:09 質問
【43696】Re:空白のセルに自動で貼り付け かみちゃん 06/10/23(月) 12:00 発言
【43730】Re:空白のセルに自動で貼り付け Help me!! 06/10/24(火) 8:14 お礼
【43718】Re:空白のセルに自動で貼り付け Kein 06/10/23(月) 16:35 発言
【43731】Re:空白のセルに自動で貼り付け Help me!! 06/10/24(火) 8:33 お礼
【43738】Re:空白のセルに自動で貼り付け Kein 06/10/24(火) 13:38 発言

38179 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free