次の動作をするExcel(エクセル)2007のVBA(マクロ)コードを教えていただきたいです。

Question

ヘンリ

12

12もっと見る

1200pt

コンピュータ

次の動作をするExcel(エクセル)2007のVBA(マクロ)コードを教えていただきたいです。

【ある条件下で、テキストボックスに入力されている文字列をそのまま入力して、黄色く塗りつぶす】VBAコードになります。

(※長くなってしまったので、具体的な｢続き｣を、このページ下部の｢コメント｣欄に書かせていただきます。
よろしくおねがいします。)

回答の条件

1人1回まで

登録：2014/10/19 18:33:07
終了：2014/10/22 21:01:46

※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

ヘンリ 2014/10/19 18:33:45

(ここまで見ていただいてありがとうございます。)

【Sheet1】のU列のみでの動作になります。

教えていただきたいのは、テキストボックスに入力されている文字列をそのまま入力して、黄色く塗りつぶすVBAコードです。

まず、(画像もアップさせていただいたのですが)
動作対象となるU列の上の方に
ラベル(Label1、アクティブXコントロール)を設置して、その上にテキストボックス(TextBox1、アクティブXコントロール)とコマンドボタン(CommandButton4、アクティブXコントロール)を設置します。

●動作の流れ

①テキストボックスに文字列を入力します。
　↓↓↓
②｢テキストボックスに入力された文字列｣を入れたいセルを選択します。
(離れたセルも含め、セルの複数選択もできるようにしたいです。)
　↓↓↓
③コマンドボタンを押します。
　↓↓↓
④選択された全てのセルの(行の)U列に、｢テキストボックスに入力された文字列｣を入力し、黄色く塗りつぶします。
また、U列のみでの動作になるので、選択したセルがどこの列でも(横に複数選択した場合でも)その行のU列に｢テキストボックスに入力された文字列｣を入力し、黄色く塗りつぶしたいです。

●ただし条件がありまして、すでにその行のU列に【何かしらのデータ】が存在する場合はメッセージボックスで
新しいデータ(文字列)で上書きするかどうかを問うてくる仕様にしたいです。

※ここで言う【何かしらのデータ】というのは、文字列だけではなく
セルに何かの色が付いているだけでもデータも見なし、
スペース(半角全角問わず)が入っているだけでもデータが入っていると見なします。
↑↑
(スペースについては、見た目には何も存在しないように見えますがデータとして扱いたいです。)

そして、選択したセルの行のU列のセル(分かりにくい日本語ですいません。)に
何もデータが存在しない場合は自動的に(Excel画面をスクロール移動することなくその画面のまま)、｢テキストボックスに入力された文字列｣を入力し、黄色く塗りつぶします。

何かしらのデータが存在した場合には、入力するセルが見える場所までExcel画面をスクロール移動して(そのセルが見えるならどこでもいいのですが)
【メッセージボックス：新しいデータで上書きしますか？】という窓を開き、
【はい】を選んだ場合は｢テキストボックスに入力された文字列｣を入力し、黄色く塗りつぶします。

【いいえ】を選んだ場合は、何も入力しません(元から存在するデータのまま変化させません)。

●アップした画像で言いますと、
【Excelの行番号】
9行目
11行目
12行目
14行目

を同時に選択した場合に一回だけ実行した結果になっています。

そもそも上記で書いた通りに実現可能なのかどうかが分からないのですが、
可能ならば、どうかそのVBAコードを教えていただきたいです。

※ここまでで、説明が分かりにくい部分や情報の不備などがありましたら、
コメント欄でご指摘をお願いいたします。
Yo 2014/10/19 19:34:45

シートのサンプルがあるのであれば、オンラインストレージからダウンロードできるといいですね。

例えば、firestorage（http://firestorage.jp/）とか？
ヘンリ 2014/10/19 20:41:15

Yoshiya　さんへ

コメントしていただきまして、ありがとうございます。

オンラインストレージという無料サービスがあったんですね！
教えていただき感謝です。

サンプルとも言えないようなサンプルですが、
URLを載せさせていただきますね。
最初にアップした画像のまんまなので、何の参考にもならないかもしれないですが。

http://firestorage.jp/download/dd783916f628a177f72b7a5877066098e7555db4
ダウンロードパスワード：tzyxw8jh
Yo 2014/10/19 22:29:43

とりあえず作ってみました。

Option Explicit

Private Sub CommandButton4_Click()

Dim Text As String
Dim SelectRow As Range
Dim SelectRowNo As Long
Dim Res As Integer

'テキストボックスの文字列を取得（文字列無しの場合は終了）
If TextBox1.Value = "" Then
Exit Sub
End If
Text = TextBox1.Value

'選択されたセルをチェック（選択順）
For Each SelectRow In Selection.Rows
SelectRowNo = SelectRow.Row - 1
With Range("U1").Offset(SelectRowNo)
'セルに文字が無く、かつセルが塗りつぶされていない
If .Value = "" And .Interior.ColorIndex = xlNone Then
.Value = Text
.Interior.ColorIndex = 6
Else
.Select
Res = MsgBox("新しいデータで上書きしますか？", vbYesNo + vbQuestion)
If Res = vbYes Then
.Value = Text
.Interior.ColorIndex = 6
End If
End If
End With
Next SelectRow

End Sub

保存場所（パスワード:hquestion）
http://firestorage.jp/download/8f984771dcd5fc2b027910bcbda4187d2d2f14e4
ヘンリ 2014/10/20 21:50:21

Yoshiya さんへ

この度もVBAコードを考えていただきまして、誠にありがとうございます。
オンラインストレージでダウンロードさせていただきました。
私の分かりにくい説明をほぼ忠実に再現していただき、嬉しいです!

ただ、
何回も試してみて気になる部分がありましたので書かせていただけないでしょうか。

条件は分からないのですが、何度か実行しているとたまに発生することがあります。

それは、前回選択したセルに対して上書きするかどうか聞いてきて、
(｢はい｣を選んでも｢いいえ｣を選んでも)そこから｢一番最近選択されたセルの行のU列｣に入力する仕様になっているようです。

結果は変わらないのですが、ちょっと気になりまして。

また、ここからの2つは私のわがままなのでもし可能ならばお願いしたいところなのですが、

【1つ目】
コメント欄に書かせていただいた説明文で

----------------------------------------------------------------------------
●ただし条件がありまして、すでにその行のU列に【何かしらのデータ】が存在する場合はメッセージボックスで
新しいデータ(文字列)で上書きするかどうかを問うてくる仕様にしたいです。

※ここで言う【何かしらのデータ】というのは、文字列だけではなく
セルに何かの色が付いているだけでもデータも見なし、
スペース(半角全角問わず)が入っているだけでもデータが入っていると見なします。
↑↑
(スペースについては、見た目には何も存在しないように見えますがデータとして扱いたいです。)
----------------------------------------------------------------------------
上記のように説明してしまったのですが、これを下のように訂正させていただきたいのです。

↓↓↓

----------------------------------------------------------------------------
●ただし条件がありまして、すでにその行のU列に【何かしらのデータ】が存在する場合はメッセージボックスで
新しいデータ(文字列)で上書きするかどうかを問うてくる仕様にしたいです。

※ここで言う【何かしらのデータ】というのは、

【U列】に
①何かしらの文字列が入っている状態を指します。
②また、スペース(半角全角問わず)だけでもデータが入っていると見なします。
↑↑
(スペースについては、見た目には何も存在しないように見えますがデータとして扱いたいです。)

※ただし、【U列】にすでに何かの色が付いているだけの場合はデータとは見なさないようにしていただきたいです。
----------------------------------------------------------------------------

というのも、私の使うExcelはアクティブセルの行に色を付けているですが(セルを選べばその行に必ず色が付いてしまうのです)、
説明文やサンプルに実装するのを忘れていまして。

【2つ目】
U列というのはある作業を終えたらチェックを入れる列なのですが、
これは一個左の列【T列】のチェックを終えていないと書き込まないようにしている列なのです。
T列でのチェックなしに、いきなりU列でチェックすることは原則不可能にしたいところがありまして、
流れ上、T列が先にあって→U列という順番になっているのです。
(同じ行においてT列に何の文字列もないのに、いきなりU列に文字列が存在しているということは回避したいのです。)

そこで、テキストボックスに入力された文字列をコマンドボタンで実行するときに、
(同じ行において)左の列である【T列】に何かしらの文字列が存在することを確認してから【U列】に書き込むようにしていただきたいのです。

●流れはこのような感じになります。
↓↓↓
①テキストボックスに文字列を入力。
②入力したい行のセルを選択(複数選択でも可能)。
③コマンドボタンを押す。
┣T列に文字列があれば、そのままExcelをスクロールすることもなく、メッセージボックスを開くこともなくその場で自動入力してほしいです。
┗その行のT列に何の文字列もない場合(チェックが入っていない場合)、
メッセージボックス：｢T列の作業がまだ終わっていません。｣と開くようにして、その行のU列には何も書き込まないようにする。
(※書き込まないのですが、メッセージボックスを開いたときに、そのU列が見える位置にExcelをスクロールしていただきたいです。見えればどこでも構いません)

----------------------------------------------------------------------------
※T列でいう文字列というのは、

【T列】に
①何かしらの文字列が入っている状態を指します。
②また、スペース(半角全角問わず)だけでもデータが入っていると見なします。
↑↑
(スペースについては、見た目には何も存在しないように見えますがデータとして扱いたいです。)

※ただし、【T列】にすでに何かの色が付いているだけの場合はデータとは見なさないようにしていただきたいです。
----------------------------------------------------------------------------

色をデータとして見なさない仕様がいい、というのはこちらのサンプルを見て頂くと意味がわかるかもしれません。
選択したセルの行に色がつきますので。
http://firestorage.jp/download/7ae7e30e3f76e176dee560b8b62e0f35e6167cc8
ダウンロードパスワード：xtvqxx1c

かなりの長文になってしまいました。
もし可能な部分があれば、その部分を反映させたコードを教えていただきたいです。

また、分かりにくい部分がありましたらご指摘いただきたいです。
Yo 2014/10/20 23:29:59

修正してみました。

Private Sub CommandButton4_Click()

Dim Text As String
Dim SelectRow As Range
Dim SelectRowNo As Long
Dim Res As Integer

'テキストボックスの文字列を取得（文字列無しの場合は終了）
If TextBox1.Value = "" Then
Exit Sub
End If
Text = TextBox1.Value

'選択されたセルをチェック（選択順）
For Each SelectRow In Selection.Rows
SelectRowNo = SelectRow.Row - 1

If SelectRowNo > 8 Then
With Range("U1").Offset(SelectRowNo)
'T列セルに文字が無い場合
If Range("T1").Offset(SelectRowNo) = "" Then

'テスト用
Res = MsgBox("対象番号：" & SelectRowNo - 7 & vbCr & vbCr & "T列の作業がまだ終わっていません。", vbOKOnly + vbExclamation)

'本番用
' Res = MsgBox("T列の作業がまだ終わっていません。", vbOKOnly + vbExclamation)

Else
'U列セルに文字が無く、かつセルが塗りつぶされていない
If .Value = "" Then
If .Interior.ColorIndex = xlNone Then
.Value = Text
.Interior.ColorIndex = 6
End If
Else
.Select
'テスト用
Res = MsgBox("対象番号：" & SelectRowNo - 7 & vbCr & vbCr & "新しいデータで上書きしますか？", vbYesNo + vbQuestion)

'本番用
' Res = MsgBox("新しいデータで上書きしますか？", vbYesNo + vbQuestion)
If Res = vbYes Then
.Value = Text
.Interior.ColorIndex = 6
End If
End If
End If
End With
End If
Next SelectRow

'セル選択解除
Range("A1").Select

End Sub

実行行がわかりやすい様に、メッセージボックスに行数を追加しました。
（テストコードなので、実際に使用する際は本番用に置き換えてください。）

修正コードはsample2.xlsmに上書きしています。
http://firestorage.jp/download/e98b850c168dfd0c8e702ef93ecb958609fd875e
ヘンリ 2014/10/21 00:19:06

Yoshiya さんへ

対応していただきまして、ありがとうございます。
また、
sample2.xlsmに上書きという配慮ありがたいです。

さっそくダウンロードさせていただき、試させていただきました。

メッセージボックス：｢T列の作業がまだ終わっていません。｣を表示する仕様にしていただきましてありがとうございます。

ただ、気になるところがあったのでまたコメントをさせていただきたいです。
よろしくお願いいたします。

①コマンドボタンを押すと、アクティブセルが1行目に移動してしまうという結果になるようです。
テキストボックスの内容を、｢選択したセルの行のU列｣に書き込む仕様にしていただけますと助かります。

②メッセージボックス：｢T列の作業がまだ終わっていません。｣を表示するときなのですが、
そのメッセージボックスを開く対象のセル(U列)が見える位置にExcel画面をスクロールしていただけると個人的にとても便利になるので、ご対応いただけないでしょうか。
そのセル(U列)が見える位置なら、どこにスクロールしていただいても構いません。

何度も申し訳ございません。

ここまでで、分かりにくい説明がありましたらどうかご指摘をお願いいたします。
Yo 2014/10/21 09:27:18

ヘンリさま

＞①コマンドボタンを押すと、アクティブセルが1行目に移動してしまうという結果になるようです。
＞テキストボックスの内容を、｢選択したセルの行のU列｣に書き込む仕様にしていただけますと助かります

処理が完全に終了した際、選択したセルを解除する為に、わざとA1セルを選択しています。
（エクセルの仕様上、選択したセルを解除（セルが選択されていない状態）にするのは不可能）
最後に処理したセルを選択した状態で終了させるのであれば、「Range("A1").Select」を削除すればOKです。

>②メッセージボックス：｢T列の作業がまだ終わっていません。｣を表示するときなのですが、
>そのメッセージボックスを開く対象のセル(U列)が見える位置にExcel画面をスクロールしていただけると個人的にとても便利に>なるので、ご対応いただけないでしょうか。
>そのセル(U列)が見える位置なら、どこにスクロールしていただいても構いません。

これはちょっと難しいです。
理由は、ディスプレイの解像度が違うからです。
通常、メッセージボックスはアクティブウィンドの真ん中に表示される様になっています。
画面の真ん中が選択されたセルがある場合、メッセージボックスに被るのは避け様がありません。
これを回避する方法としては。アクティブウィンドの真ん中よりも上ないしは下に選択したセルをスクロールさせることになるのですが、移動させる場所が特定できない状態では、何とも仕様がありません。

（変更したソースコード）

Private Sub CommandButton4_Click()

Dim Text As String
Dim SelectRow As Range
Dim SelectRowNo As Long
Dim Res As Integer

'テキストボックスの文字列を取得（文字列無しの場合は終了）
If TextBox1.Value = "" Then
Exit Sub
End If
Text = TextBox1.Value

'選択されたセルをチェック（選択順）
For Each SelectRow In Selection.Rows
SelectRowNo = SelectRow.Row - 1

If SelectRowNo > 7 Then
With Range("U1").Offset(SelectRowNo)
'T列セルに文字が無い場合
If Range("T1").Offset(SelectRowNo) = "" Then

'テスト用
Res = MsgBox("対象番号：" & SelectRowNo - 7 & vbCr & vbCr & "T列の作業がまだ終わっていません。", vbOKOnly + vbExclamation)

'本番用
' Res = MsgBox("T列の作業がまだ終わっていません。", vbOKOnly + vbExclamation)

Else
'U列セルに文字が無く、かつセルが塗りつぶされていない
If .Value = "" Then
.Value = Text
If .Interior.ColorIndex = xlNone Then
.Interior.ColorIndex = 6
End If
Else
.Select

'テスト用
Res = MsgBox("対象番号：" & SelectRowNo - 7 & vbCr & vbCr & "新しいデータで上書きしますか？", vbYesNo + vbQuestion)

'本番用
' Res = MsgBox("新しいデータで上書きしますか？", vbYesNo + vbQuestion)
If Res = vbYes Then
.Value = Text
.Interior.ColorIndex = 6
End If
End If
End If
End With
End If
Next SelectRow

'セル選択解除
' Range("A1").Select

End Sub

修正したワークシートの保存場所
http://firestorage.jp/download/f2bb0972c8bf52af8faac80204627f2d3d4ea11a
ヘンリ 2014/10/21 20:27:53

Yoshiya さんへ

私の無理難題について分かりやすく解説していただきまして、
ありがとうございます。

VBAでも状況により出来ること、出来ないことがあるという分別がついていない自分にはとてもありがたいです。

さっそく新しいコードを試させていただきました。
かなり理想に近づいてきたと思います。

僭越ながら、今回も気になる部分がありましたので書かせていただきたいです。

①行番号を選択した場合と、上書きした場合は黄色く塗りつぶしてくれるのですが、
それ以外だと文字列を入力するだけで黄色く塗りつぶさないようです。

これを文字列を入力するときは必ず、黄色く塗りつぶすという仕様に変更することは可能でしょうか。

②ある1行において、離れたセルを複数選択した場合(例：Q9とS9を同時に選択)、セルを１つずつ処理するようでして、
必ず上書きするか訊いてくる仕様だと思いますので、これを同じ行で複数選択された場合は(連続で選択された場合も離れて選択された場合も)、一回だけ選択されたと扱う(まとめてセル一個として扱う)仕様にすることはできますでしょうか。

今回も分かりにくい書き方になってと思いますので、伝わなかった部分はどうかご指摘をお願いいたします。
毎回最後まで読んでいただきまして、ありがとうございます。
Yo 2014/10/21 21:45:02

ヘンリ様

＞①行番号を選択した場合と、上書きした場合は黄色く塗りつぶしてくれるのですが、
＞それ以外だと文字列を入力するだけで黄色く塗りつぶさないようです。

＞これを文字列を入力するときは必ず、黄色く塗りつぶすという仕様に変更することは可能でしょうか。

上記の不具合は私のミスです。　修正可能です。

修正前）
'U列セルに文字が無く、かつセルが塗りつぶされていない
If .Value = "" Then
.Value = Text
If .Interior.ColorIndex = xlNone Then
.Interior.ColorIndex = 6
End If

修正後）
'U列セルに文字が無い
If .Value = "" Then
.Value = Text
.Interior.ColorIndex = 6

＞②ある1行において、離れたセルを複数選択した場合(例：Q9とS9を同時に選択)、セルを１つずつ処理するようでして、
＞必ず上書きするか訊いてくる仕様だと思いますので、これを同じ行で複数選択された場合は(連続で選択された場合も
＞離れて選択された場合も)、一回だけ選択されたと扱う(まとめてセル一個として扱う)仕様にすることはできますでしょうか。

セルの選択を行単位で考えていたので、同一行に選択セルが複数かる場合は想定していませんでした。
それと、同一列・複数行の処理を一括で行うとすると、アルゴリズムそのものを考えなおさなければなりません。
とりあえず考えてみます。
ヘンリ 2014/10/21 22:18:48

Yoshiya 様へ

ご返答いただきまして、ありがとうございます。

さっそく修正箇所を実装させていただきました。

①については、エラーもなにもなくスムーズに機能させていただきまして、
非常にありがたい限りです。

②についてですが、大変なお手数をおかけしますこと申し訳ございません。
私自身も普段は、1行において離れた選択はあまりしないのですが、
もしものときも考えて先に対応させておいた方がいいかもしれないという願望からワガママを書かせていただきました。

急ぎなどではありませんので、
ぜひYoshiyaさんの生活スタイルの方を優先していただいて、
もしお時間の余裕がありましたらお考えになっていただけると嬉しいです。

毎回ありがとうございます。

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

リクエスト送信済

回答リクエストを送信したユーザーはいません

きゃづみぃ · Accepted Answer · 2014-10-19T22:23:43+09:00

No.1

きゃづみぃ1353911982014/10/19 22:23:43

1200pt

Private Sub CommandButton4_Click()
    Dim aa As Long
    Dim ar As Long
    
    ac = "U"
    
    For aa = 1 To Selection.Areas.Count
        For bb = 1 To Selection.Areas(aa).Count
             f = 1
             If Selection.Areas(aa).Count > 1 Then
                ar = Selection(bb).Areas(aa).Row
            Else
                ar = Selection.Areas(aa).Row
             End If
             
             If Cells(ar, ac).Interior.Pattern <> xlNone Or Cells(ar, ac) <> "" Then
                ActiveWindow.ScrollRow = ar
                
                If MsgBox("新しいデータで上書きしますか?", vbOKCancel) = vbCancel Then
                    f = 2
                End If
            End If
            
            If f = 1 Then
                Cells(ar, ac) = TextBox1.Text
                Cells(ar, ac).Interior.ColorIndex = 6
            End If
        
        Next bb
        
    Next aa
End Sub

他7件のコメントを見る

きゃづみぃさんへ

コードのご回答ありがとうございます。

さっそく実装させていただきました。

私のしたいことの大部分は実現できてますね。
ありがとうございます。

ただ細かい部分になるのですが、
いくつか気になるところがありましたので書かせていただきたいです。

まず横に連続で選択すると(2列以上まとめて選択すると)、メッセージボックスで上書きするか訊いてくるのですが、
これを横に複数選択した場合でもメッセージボックス開かないようにしていただくことは可能でしょうか。

もちろん、U列にすでにデータが存在する場合はメッセージボックスで上書きするかどうかを訊いてきてほしいです。

それから、今度は横ではなく縦でセルを複数選択する場合なのですが、
離れたセルをいくつか選択すると(いくつ選ぶと・・、などの条件は分からないのですが)

----------------------------------------------------------------------------
実行時エラー '1004':
アプリケーション定義またはオブジェクト定義のエラーです。
----------------------------------------------------------------------------
上記のようなエラーが発生してしまいます。

これを、離れたセルを複数選択しても(何個選択しても)、エラーにならないようにはできますでしょうか。
可能ならば、どうかよろしくお願いいたします。

また、ここからはただの私のワガママであり、はじめの説明文に書き忘れてしまったことなので、
もし可能ならば、という話になるのですが。
さらにこうして欲しいという条件が2つあります。

【1つ目】
はじめのコメント欄に書かせていただいた説明文で

----------------------------------------------------------------------------
●ただし条件がありまして、すでにその行のU列に【何かしらのデータ】が存在する場合はメッセージボックスで
新しいデータ(文字列)で上書きするかどうかを問うてくる仕様にしたいです。

※ここで言う【何かしらのデータ】というのは、文字列だけではなく
セルに何かの色が付いているだけでもデータも見なし、
スペース(半角全角問わず)が入っているだけでもデータが入っていると見なします。
↑↑
(スペースについては、見た目には何も存在しないように見えますがデータとして扱いたいです。)
----------------------------------------------------------------------------
上記のように説明してしまったのですが、これを下のように訂正させていただきたいのです。

↓↓↓

----------------------------------------------------------------------------
●ただし条件がありまして、すでにその行のU列に【何かしらのデータ】が存在する場合はメッセージボックスで
新しいデータ(文字列)で上書きするかどうかを問うてくる仕様にしたいです。

※ここで言う【何かしらのデータ】というのは、

【U列】に
①何かしらの文字列が入っている状態を指します。
②また、スペース(半角全角問わず)だけでもデータが入っていると見なします。
↑↑
(スペースについては、見た目には何も存在しないように見えますがデータとして扱いたいです。)

※ただし、【U列】にすでに何かの色が付いているだけの場合はデータとは見なさないようにしていただきたいです。
----------------------------------------------------------------------------

というのも、私の使うExcelはアクティブセルの行に色を付けているですが(セルを選べばその行に必ず色が付いてしまうのです)、
説明文やサンプルに実装するのを忘れていまして。

【2つ目】
U列というのはある作業を終えたらチェックを入れる列なのですが、
これは一個左の列【T列】のチェックを終えていないと書き込まないようにしている列なのです。
T列でのチェックなしに、いきなりU列でチェックすることは原則不可能にしたいところがありまして、
流れ上、T列が先にあって→U列という順番になっているのです。
(同じ行においてT列に何の文字列もないのに、いきなりU列に文字列が存在しているということは回避したいのです。)

そこで、テキストボックスに入力された文字列をコマンドボタンで実行するときに、
(同じ行において)左の列である【T列】に何かしらの文字列が存在することを確認してから【U列】に書き込むようにしていただきたいのです。

●流れはこのような感じになります。
↓↓↓
①テキストボックスに文字列を入力。
②入力したい行のセルを選択(複数選択でも可能)。
③コマンドボタンを押す。
┣T列に文字列があれば、そのままExcelをスクロールすることもなく、メッセージボックスを開くこともなくその場で自動入力してほしいです。
┗その行のT列に何の文字列もない場合(チェックが入っていない場合)、
メッセージボックス：｢T列の作業がまだ終わっていません。｣と開くようにして、その行のU列には何も書き込まないようにする。
(※書き込まないのですが、メッセージボックスを開いたときに、そのU列が見える位置にExcelをスクロールしていただきたいです。見えればどこでも構いません)

----------------------------------------------------------------------------
※T列でいう文字列というのは、

【T列】に
①何かしらの文字列が入っている状態を指します。
②また、スペース(半角全角問わず)だけでもデータが入っていると見なします。
↑↑
(スペースについては、見た目には何も存在しないように見えますがデータとして扱いたいです。)

※ただし、【T列】にすでに何かの色が付いているだけの場合はデータとは見なさないようにしていただきたいです。
----------------------------------------------------------------------------

ここまで読んでいただきまして誠にありがとうございます。
もし可能な部分があれば、その部分を反映させたコードを教えていただきたいです。

また、分かりにくい部分がありましたらどうかご指摘いただきたいです。

2014/10/20 22:41:47

Private Sub CommandButton4_Click()

    Dim aa As Long
    Dim ar As Long

    ac = "U"

    For aa = 1 To Selection.Areas.Count
        For bb = 1 To Selection.Areas(aa).Count
             f = 1
             If Selection.Areas(aa).Count > 1 Then
                ar = Selection(bb).Areas(aa).Row
            Else
                ar = Selection.Areas(aa).Row
             End If

             If Cells(ar, "T") <> "" Then
                 If Cells(ar, ac) <> "" Then
                    ActiveWindow.ScrollRow = ar
    
                    If MsgBox("新しいデータで上書きしますか?", vbYesNo) = vbNo Then
                        f = 2
                    End If
                End If
            Else
                f = 2
            End If

            If f = 1 Then
                Cells(ar, ac) = TextBox1.Text
                Cells(ar, ac).Interior.ColorIndex = 6
            End If

        Next bb

    Next aa

End Sub

追加の分に対応しました。

2014/10/20 22:50:12

おっと　コメントが追加されてましたね。

2014/10/20 22:51:02

コメントに対応しました。

Private Sub CommandButton4_Click()

    Dim aa As Long
    Dim ar As Long
    Dim cc As Long

    ac = "U"
    cc = 0
    For aa = 1 To Selection.Areas.Count
        For bb = 1 To Selection.Areas(aa).Count
             f = 1
            
            If Selection.Areas(aa).Count > 1 Then
                ar = Selection(bb).Areas(aa).Row
            Else
                ar = Selection.Areas(aa).Row
            End If
            
            If cc = ar Then
                f = 2
            Else
                If Cells(ar, "T") <> "" Then
                    If Cells(ar, ac) <> "" Then
                        ActiveWindow.ScrollRow = ar
                        If MsgBox("新しいデータで上書きしますか?", vbYesNo) = vbNo Then f = 2
                    End If
                Else
                    f = 2
                End If
                cc = ar
            End If


            If f = 1 Then
                Cells(ar, ac) = TextBox1.Text
                Cells(ar, ac).Interior.ColorIndex = 6
            End If

        Next bb

    Next aa

End Sub

2014/10/20 23:04:43

きゃづみぃさんへ

こんなに早くご返答いただきまして、ありがとうございます!

今回のコードも本当に、私の理想に近いです。
ワガママにお付き合いいただきまして、ありがたいです。

ただ、少しだけ気になる箇所がありましたので書かせてください。

①まず、
セルを縦に選択した場合にエラーが発生するようです。
それも連続したセル(2個以上選択したセル)を飛び飛びで選択した場合にエラーになります。

たとえば、ある1列において

1行目(セル選択)
2行目(セル選択)
3行目
4行目(セル選択)
5行目(セル選択)

上記のように選択した場合、

----------------------------------------------------------------------------
実行時エラー '1004':
アプリケーション定義またはオブジェクト定義のエラーです。
----------------------------------------------------------------------------
という窓が開いてしまいます。

②また
T列に文字列が一切ない場合(色だけ塗られている場合もですが)は、
メッセージボックス：｢T列の作業がまだ終わっていません。｣と開くようにして、その行のU列には何も書き込まないようにしていただきたいです。
(※書き込まないのですが、メッセージボックスを開いたときに、そのU列が見える位置にExcelをスクロールしていただきたいです。見えればどこでも構いません)

それで、複数のセルを選択していてまだ動作の途中だった場合、メッセージボックスを閉じたら続きの行の処理を行うという流れだと理想的です。

ここまでで、
分かりにくい部分がありましたらどうかご指摘いただきたいです。

2014/10/21 00:08:24

Private Sub CommandButton4_Click()

    Dim aa As Long
    Dim ar As Long
    Dim cc As Long

    ac = "U"
    cc = 0
    For aa = 1 To Selection.Areas.Count
        For bb = 1 To Selection.Areas(aa).Count
             f = 1
            
            If Selection.Areas(aa).Count > 1 Then
                ar = Selection.Areas(aa).Row + bb - 1
            Else
                ar = Selection.Areas(aa).Row
            End If
            
            If cc = ar Then
                f = 2
            Else
                If Cells(ar, "T") <> "" Then
                    If Cells(ar, ac) <> "" Then
                        ActiveWindow.ScrollRow = ar
                        If MsgBox("新しいデータで上書きしますか?", vbYesNo) = vbNo Then f = 2
                    End If
                Else
                    f = 2
                    ActiveWindow.ScrollRow = ar
                    MsgBox "T列の作業がまだ終わっていません。"
                End If
                cc = ar
            End If


            If f = 1 Then
                Cells(ar, ac) = TextBox1.Text
                Cells(ar, ac).Interior.ColorIndex = 6
            End If

        Next bb

    Next aa

End Sub

エラーも出なくなったと思います。

2014/10/21 01:25:41

きゃづみぃさんへ

お返事が遅れました。すいません。

エラーに対応したコードに変更していただきまして、どうもありがとうございます。
本当に前回書かせていただいた状況下ではエラーが出なくなりまして、とても助かりました。

ただ、今回は一難去ってまた一難といいますか、違う部分で気になる結果がありましたので
どうか書かせていただきたいです。

横に連続して複数選択した場合、その行だけでなく、選択したセルの数だけ(その行も含めて下に)入力されてしまうようです。
行を(行番号で)選択すると、【T列の作業がまだ終わっていません。】の窓が出現して【OK】を押し続けても永遠に窓が消えないという現象が起こったりします。
(そうなると、自分の場合Excelを閉じるにはパソコンをシャットダウンするしか方法が分からず、対処が分からないものでして。)

ですので、
これを横に複数選択された場合でも(1行において離れたセルを選択された場合も複数選択された場合に含めます。)、その行で一回だけU列に入力するという仕様に変更することはできますでしょうか。

何度も申し訳ございません。

2014/10/21 20:41:04

Private Sub CommandButton4_Click()

    Dim aa As Long
    Dim ar As Long

    ac = "U"
    For aa = 1 To Selection.Areas.Count
        For bb = 1 To Selection.Areas(aa).Rows.Count
            f = 1
            
            ar = Selection.Areas(aa).Row + bb - 1
            
            If Cells(ar, "T") <> "" Then
                If Cells(ar, ac) <> "" Then
                    ActiveWindow.ScrollRow = ar
                    If MsgBox("新しいデータで上書きしますか?", vbYesNo) = vbNo Then f = 2
                End If
            Else
                f = 2
                ActiveWindow.ScrollRow = ar
                MsgBox "T列の作業がまだ終わっていません。"
            End If

            If f = 1 Then
                Cells(ar, ac) = TextBox1.Text
                Cells(ar, ac).Interior.ColorIndex = 6
            End If
        Next bb
    Next aa
End Sub

2014/10/21 22:13:31

きゃづみぃさんへ

私のわがままに対応していただきまして、誠にありがとうございます。

今度はメッセージボックスが出続けることもなく、スムーズに動きます。

感謝させていただきます。

2014/10/21 22:39:32

次の動作をするExcel(エクセル)2007のVBA(マクロ)コードを教えていただきたいです。

ベストアンサー

きゃづみぃ1353911982014/10/19 22:23:43

コメント（11件)

この質問への反応（ブックマークコメント）