インプットボックスの文字列追加を空白まで

質問

いつもお世話になっております。お忙しいところ申し訳ありませんが、ご教授の程お願い申し上げます。

任意の列にデータが無くなるまで文字列追加をしたく、色々模索をしておりまして処理実行後に.End(xlDown)などを使ってカーソルを移動しようと思ったのですがどうも狙った通りの動きになりません。

WEBで検索してましたら
http://can-chan.com/vba/tsuika.html#8
というURLを見つけ（対象内に任意文字後追加）という項目を見つけました。

Sub 対象内に任意文字後追加()
Dim 対象 As Range
Dim 文字 As String
文字 = InputBox("追加文字を入力してください。", "追加文字入力")
For Each 対象 In Selection
対象.Value = 対象.Value & 文字
Next 対象
End Sub

上記の構文を列のデータ（空白まで）が無くなるまでループ化することは可能でしょうか？

回答No.3

nobu_suzuki1 · ベストアンサー

認識の確認がとれたので恐らくこれで解決すると思います。
Whileの中にInputBoxを挟むだけで解決です。

Sub 対象内に任意文字後追加改()
Dim 対象 As Range
Dim 文字 As String
Dim i As Single
Dim 任意の列 As String
任意の列 = InputBox("列のアルファベットを入力してください。（例：列Aの場合「A」と入力)", "列指定")
i = 1
While Range(任意の列 & i) <> ""
Range(任意の列 & i).Select
文字 = InputBox("追加文字を入力してください。", "追加文字入力")
Range(任意の列 & i) = Range(任意の列 & i) & 文字
i = i + 1
Wend
End Sub

お礼

度々のご回答ありがとうございます、意図してた通りの動きでものすごく感激です。
本当に凄い！
何度もご回答いただきありがとうございました！
回答者様の貴重な時間を割いていただき本当にありがとうございます、また機会がありましたらよろしく御願い致します！

回答No.2

nobu_suzuki1

認識があっているか再度確認させてください。

たとえば任意の列をA列と仮定します。
A列に
1
2
3
・
・
・
498
499
500

などのデータがはいっていると仮定して、InputBoxを利用してこのA列にある１～500のデータの後ろに特定の文字（たとえば個等）を追加し、

1個
・
・
・
500個

というようにしたいということで間違いないでしょうか。
そして、そのデータの追加を行う際にシート上でアクティブなセルを上から順番に変更し、追加を行い、順次下へとセルを移動しながらデータに文字を追加するということでしょうか。
もしそうであるならば、下記コードで如何でしょうか。

Sub 対象内に任意文字後追加改()
Dim 対象 As Range
Dim 文字 As String
Dim i As Single
Dim 任意の列 As String
任意の列 = InputBox("列のアルファベットを入力してください。（例：列Aの場合「A」と入力)", "列指定")
文字 = InputBox("追加文字を入力してください。", "追加文字入力")
i = 1
While Range(任意の列 & i) <> ""
Range(任意の列 & i).Select
Range(任意の列 & i) = Range(任意の列 & i) & 文字
i = i + 1
Wend
End Sub

このままだと環境によっては高速にセルを選択し文字を追加していくことになりますので、必要であればWhile内にウェイトをかませないと目視できるレベルではなくなります。
ですので、もし目視できるレベルにまで落としたいのであれば、下記のようにウェイトを追加する必要があります。

Sub 対象内に任意文字後追加改()
Dim 対象 As Range
Dim 文字 As String
Dim i As Single
Dim 任意の列 As String
Dim waitTime As Variant
任意の列 = InputBox("列のアルファベットを入力してください。（例：列Aの場合「A」と入力)", "列指定")
文字 = InputBox("追加文字を入力してください。", "追加文字入力")
i = 1
While Range(任意の列 & i) <> ""
Range(任意の列 & i).Select
Range(任意の列 & i) = Range(任意の列 & i) & 文字
i = i + 1
Application.Wait [NOW()+"0:00:00.01"]
Wend
End Sub

上記では10ミリ秒のウェイトを持たせています。"0:00:00.01"の小数点以下がミリ秒の指定になりますので、お好みのスピードに変更してください。

もし私の認識が間違っていましたらまた追記のほどお願い申し上げます。

お礼

この度は回答者様の貴重な時間を割いていただきありがとうございます。ご丁寧なご回答の程誠にありがとうございます。

補足

ご連絡が遅くなり大変申し訳ございません、構文を提示していただいて大事にテストさせていただいておりました。

＞認識があっているか再度確認させてください。

はい、その認識で間違いないのですが、

＞～、そのデータの追加を行う際にシート上でアクティブなセルを上から順番に変更し、追加を行い、順次下へとセルを移動しながらデータに文字を追加するということでしょうか。

これをひとつのセル毎に任意の文字を入力することは可能ですか？
i認識を統一できればと思いimgを作成してみました。

http://motor.geocities.jp/xqqbk132/bidders/Okwave.jpg
私の質問仕方が悪く意図をお伝えできずに申し訳ありません、お忙しい所申し訳ありませんがご確認の程お願い申し上げます。

回答No.1

nobu_suzuki1

任意の列の最上段からデータが入っている前提でi=1としていますのでスタート位置を変えたければiの値を変更してください。

Sub 対象内に任意文字後追加改()
Dim 対象 As Range
Dim 文字 As String
Dim i As Single
Dim 任意の列 As String
任意の列 = InputBox("列のアルファベットを入力してください。（例：列Aの場合「A」と入力)", "列指定")
文字 = InputBox("追加文字を入力してください。", "追加文字入力")
i = 1
While Range(任意の列 & i) <> ""
Range(任意の列 & i) = Range(任意の列 & i) & 文字
i = i + 1
Wend
End Sub

目的がいまいち不明瞭なためこの程度になってしまいました。
また上記のように変更しなくてもご自分の引用されたプロシージャをそのまま利用することも可能ではないですか。
任意の列のデータ入力部分を選択してご自分の引用されたコードを実行するだけで対応可能かと思われます。

お礼

お忙しい所、丁寧なご回答の程ありがとうございます。

補足

迅速なご回答の程ありがとうございます。質問が定まっておらず申し訳ありません、提示していただいた構文を試してみましたところ任意の列全体（データがある部分）に文字が追加されてしまいます。これをひとつのセル入力後に↓にカーソルが動き、それをデータがなくなるまで。という動きかたはVBAで可能でしょうか？

＞ご自分の引用されたプロシージャをそのまま利用することも可能ではないですか。

確かに、引用させていただいた構文でも利用可能なのですが、特定のセルをアクティブにしてそのまま下方向に移動したいなと考えておりました。

Do Loopなども利用してみましたが・・・
宜しければご回答の程お願いいたします。