• ベストアンサー
  • すぐに回答を!

アクティブセルの右側にユーザーフォームから入力したい。

アクティブセルの右側にユーザーフォームから入力したい。 すいません初心者で困ってます。 Private Sub Worksheet_Change(ByVal Target As Range) With Target If .Column = 7 Then '色付けをColumn=??に限定 Select Case .Value '反応させる文字列の入力と(.Row ?)~(.Row?)で色塗り範囲指定 Case "完了" Range(Cells(.Row, 3), Cells(.Row, 13)).Interior.ColorIndex = 0 UserForm2.Show Case "提出中" Range(Cells(.Row, 3), Cells(.Row, 13)).Interior.ColorIndex = 6 Case Else Range(Cells(.Row, 3), Cells(.Row, 13)).Interior.ColorIndex = 0 End Select End If End With End Sub 台帳を作ってるんですが、リストから選択して”完了”と入力されるとUserForm2が開いて完了日を入力したいと思っております。 UserForm2はスピンボタンでそこそこ完成したんですが、”完了”に切り替えたセルの隣のセルに入力の方法が分からなくて困っております。 どなたか御教授ください。

共感・応援の気持ちを伝えよう!

  • 回答数1
  • 閲覧数290
  • ありがとう数3

質問者が選んだベストアンサー

  • ベストアンサー
  • 回答No.1

なにが入力したいのか、よく分からないので参考までに アクティブセルの右セルに、値「1」をセットするには Activecell.Offset(,1).Value=1 で入ります。これを参考に

共感・感謝の気持ちを伝えよう!

質問者からの補足

早速のお返事有難うございます。 まったくの初心者なので質問もどうすれば良いか分からず困ってました。 Activecell.Offset(,1).Value= 早速試してみました。ホボ狙い通りです。 ただユーザーフォーム1から「完了」を入力するとユーザーフォーム2も同時に開いてしまいます。 その時にタブキーでカーソルを送ると狙い通りのセルに入らないので・・ アクティブになったセルの列のHに反映させるにはどうしたら良いか? もしお時間があれば御教授願います。

関連するQ&A

  • 入力数値によってセル色が決まるコードで変更が正しく反映されません

    セルの入力数値によってセルの塗りつぶし色が決まるコードを自作してみました。 0 =< x < 2 : 赤 2 =< x < 4 : 青 4 =< x < 6 : 黄 6 =< x < 8 : 黄緑 8 =< x < 10: ピンク それ以外 : 塗りつぶしなし なんとなくCaseの使い方が正確ではないような気もしますが。。。 ここで困ったことがおきました。手動で数字を入力すると、一応意図したとおりにセルの塗りつぶし色が反映されます。しかし、一旦塗りつぶされたセルの数値を消去しても、塗りつぶしなしとはならずに赤くなってしまいます。 また、対象外のセルから数字を一つコピーして対象セルに貼り付けると、意図したとおりに色が反映されます。しかし、二つ以上のセルをコピーして貼り付けようとすると、実行エラー'13'型が一致しません、というエラーが出てしまいます。 原因が分かりましたらご教示いただけると幸いです。 --- Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column >= 1 And Target.Column <= 10 Then If Target.Row >= 1 And Target.Row <= 10 Then Select Case Target.Value Case 0 To 2 Target.Interior.ColorIndex = 3 Case 2 To 4 Target.Interior.ColorIndex = 5 Case 4 To 6 Target.Interior.ColorIndex = 6 Case 6 To 8 Target.Interior.ColorIndex = 4 Case 8 To 10 Target.Interior.ColorIndex = 7 Case Else Target.Interior.ColorIndex = 2 End Select End If End If End Sub ---

  • セルの選択でその行に色を付けたい

    横に長いデータがあり、その1つのセルを選択するとその行全体に色が付くようにしたいのです。過去の質問で以下のようなものを見つけましたが、問題はその場合、通常のコピー→貼り付けができない点です。 その辺を問題なく行える方法はないでしょうか? よろしくお願いいたします。 Public m, n Private Sub Worksheet_SelectionChange(ByVal Target As Range) If m <> 0 Then Range(Cells(m, 1), Cells(m, 256)).Interior.ColorIndex = n End If m = Target.Row n = Target.Interior.ColorIndex Range(Cells(Target.Row, 1), Cells(Target.Row, 256)).Interior.ColorIndex = 6 End Sub

  • エクセルVBA 選択した値でセルの色を変える方法

    エクセルのVBAです。 指定されたセルの値をプルダウンで選択し、入力(選択)された値によって同じ列の指定した範囲に色を付ける、という内容です。 これを、一つの列のみで行う場合は、以下のコードでOKでした。 わからないのは、列の範囲が5~40まであり、それぞれ値を選択した時にそのセルと同じ列の指定範囲に色をつけることです。 ちなみに、条件付き書式は、すでに条件がいくつかついているため 使用できないという前提でお願いします) ちょっと説明がわかりづらいですが、おわかりになる方いらっしゃいましたら教えてください。よろしくお願いします!! ・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・ Private Sub Worksheet_Change(ByVal Target As Range) a = Cells(33, 5).Value Select Case a Case "A" Range("E6:E31").Interior.ColorIndex = 6 Case "B" Range("E6:E17").Interior.ColorIndex = 8 Range("E18:E31").Interior.ColorIndex = 2 Case "C" Range("E18:E31").Interior.ColorIndex = 8 Range("E6:E17").Interior.ColorIndex = 2 Case "" Range("E6:E31").Interior.ColorIndex = 2 End Select End Sub ・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・・ Cells(33, 5)で A を選択した時は、E6:E31を黄色で。 B を選択した時は、E6:E17を水色かつE18:E31を白 C を選択した時は、E18:E31を水色かつE6:E17を白 値なしを選択した時は、色なし(白)

  • セルの塗りつぶしマクロを作ったのですが・・

    初めて投稿します。どうぞよろしくお願いします。 エクセルの条件付き書式では4通りにしか設定できないため、マクロ初心者ではありますが、こちらでの回答を参考に作ってみました。 0~0.999 薄ピンク 1~1.999 ピンク 2~2.999 赤 3~3.999 オレンジ   ↓   ↓ 25~25.999 濃い紫 と26パターンに自動的に塗りつぶすマクロを作りました。 ところが空白のセルも0~0.999で指定している薄ピンクに塗りつぶされてしまいます。 何分初心者なもので、どこを修正したら良いのかわかりません。 どなたかアドバイス頂けると助かります。 よろしくお願いします。 Sub color0_25() Dim Target As Range For Each Target In Range("A1:Z1000") Select Case Target.Value Case Is < 0 Target.Interior.ColorIndex = 0 Case Is < 1 Target.Interior.ColorIndex = 38 Case Is < 2 Target.Interior.ColorIndex = 7 Case Is < 3 Target.Interior.ColorIndex = 22 Case Is < 4 Target.Interior.ColorIndex = 3 Case Is < 5 Target.Interior.ColorIndex = 46 Case Is < 6 Target.Interior.ColorIndex = 45 Case Is < 7 Target.Interior.ColorIndex = 44 Case Is < 8 Target.Interior.ColorIndex = 6 Case Is < 9 Target.Interior.ColorIndex = 36 Case Is < 10 Target.Interior.ColorIndex = 35 Case Is < 11 Target.Interior.ColorIndex = 4 Case Is < 12 Target.Interior.ColorIndex = 50 Case Is < 13 Target.Interior.ColorIndex = 14 Case Is < 14 Target.Interior.ColorIndex = 34 Case Is < 15 Target.Interior.ColorIndex = 37 Case Is < 16 Target.Interior.ColorIndex = 33 Case Is < 17 Target.Interior.ColorIndex = 28 Case Is < 18 Target.Interior.ColorIndex = 41 Case Is < 19 Target.Interior.ColorIndex = 5 Case Is < 20 Target.Interior.ColorIndex = 11 Case Is < 21 Target.Interior.ColorIndex = 55 Case Is < 22 Target.Interior.ColorIndex = 17 Case Is < 23 Target.Interior.ColorIndex = 39 Case Is < 24 Target.Interior.ColorIndex = 54 Case Is < 25 Target.Interior.ColorIndex = 13 Case Is < 26 Target.Interior.ColorIndex = 21 End Select Next End Sub

  • マクロ 日付の内容でセルを塗りつぶす

    セルに記載された日付が、『TODAY以上なら赤色』・『TODAY以下なら青色』・『それ以外なら塗り潰し無し』にしようと下記のマクロを記述しましたが、思うようになりませんでした。どうしたら治るでしょうか?御指導お願い致します。 Sub セルを色で塗りつぶす() Dim C As Integer C = 5 Do While Cells(5, C).Value <> "" With Cells(6, C) Dim Today As Date Today = Date Select Case .Value Case Is <= Today .Interior.ColorIndex = 8 Case Is >= Today .Interior.ColorIndex = 3 Case Else .Interior.ColorIndex = xlNone End Select End With C = C + 1 Loop End Sub

  • イベントマクロについて

    イベントマクロについて質問ですが まず、下記をご覧下さい。 過去にここで回答いただいたものを流用させてもらったものですが もうひとつ機能を追加したいと思います。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column >= 4 And Target.Column <= 34 Then If Target.Row >= 2 And Target.Row <= 100 Then Select Case Target Case "(5)GC" Target.Interior.ColorIndex = 34 Target.Font.ColorIndex = 0 Case "6OS", "6FC" Target.Interior.ColorIndex = 6 Target.Font.ColorIndex = 0 Case "(6)TA", "(6)C" Target.Interior.ColorIndex = 46 Target.Font.ColorIndex = 0 Case "6@BD", "6@C" Target.Interior.ColorIndex = 38 Target.Font.ColorIndex = 0 End Select End If End If End Sub 追加する機能とは、上記で指定した範囲以外のセルを参照して 色を付けるかどうかを区別するものです。 例えば、A2の値が色付けに該当する場合はD2からAH2の中で上記マクロに該当するセルに色を付け、もしA2が該当しない場合は色付けをしない というような感じです。 よろしくお願いします。

  • VBAでのセルの複数選択時の処理について

    現在EXCEL VBAである行の値が変わったときにその列の塗りつぶしの 色を変えるといった処理を作成しております。 そこで、複数選択して値を変えた場合の処理が変数の型が一致しません 的なエラーが表示されてしまいます。 どのように修正したらうまくいくでしょうか? 教えてください。 ソースは下記の通りとなります。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 13 Then Exit Sub Application.EnableEvents = False MsgBox (Target.Rows.Count) Dim rngSelectRng As Range For Each rngSelectRng In Target If rngSelectRng.Value = "" Then rngSelectRng.Value = " " 'ステータス欄の入力の判断 'Select Case Target.Rows.Value MsgBox (Target.Row) Select Case rngSelectRng.Value Case "あああ" Worksheets("表1").Rows(Target.Row).Interior.ColorIndex = 24 Case "いいい" Worksheets("表1").Rows(Target.Row).Interior.ColorIndex = 35 Case "ううう" Worksheets("表1").Rows(Target.Row).Interior.ColorIndex = 38 Case "えええ" Worksheets("表1").Rows(Target.Row).Interior.ColorIndex = 36 Case "おおお" Worksheets("表1").Rows(Target.Row).Interior.ColorIndex = 16 Case Else Worksheets("表1").Rows(Target.Row).Interior.ColorIndex = 2 End Select Next Application.EnableEvents = True End Sub

  • EXCELで4色の色をつけるVBA(既存)を最後のシートまで実行するには?

    エクセルのVBAで質問です。 現在、下記のVBAにて、エクセルに4色の色をつけています。 内容 ・処理範囲内(D5:AI50)の列の値が、 ・指定した行(4行目)の値から見て、 ・+5、+10、-5、-10の場合、それぞれ指定した色をつけています ・ただしC列の値が30未満の行は色付けなし 現状では、このマクロはアクティブシートのみで使えるため、 100シートあれば、それぞれのシートにおいて そのつどマクロを実行しています。 これを、一度の実行で最終シートまで実行できるようにしたいのです。 VBA初心者のため、見よう見まねでループを試してみたものの、 どうもうまく動きませんでした。 なにとぞご教授のほど、お願いいます。 ●以下、現在使用しているVBA Sub 条件付4色の標本数1() Dim 処理範囲 As Range Dim 先頭の行番号 As Long Dim 全体の行数 As Long Dim 各セル As Range Dim 差分 As Single Dim 標本数 As Single Set 処理範囲 = Range("D5:AI50") For Each 各セル In 処理範囲 標本数 = Cells(各セル.Row, "C").Value If 標本数 >= 30 Then 差分 = 各セル.Value - Cells(4, 各セル.Column).Value    Select Case 差分 Case Is <= -10 各セル.Interior.ColorIndex = 37 'ペールブルー 各セル.Font.ColorIndex = 1 Case Is <= -5 各セル.Interior.ColorIndex = 34 '薄い水色 各セル.Font.ColorIndex = 1 Case Is >= 10 各セル.Interior.ColorIndex = 6 '黄37 各セル.Font.ColorIndex = 1 Case Is >= 5 各セル.Interior.ColorIndex = 19 '薄い黄 各セル.Font.ColorIndex = 1 Case Else 各セル.Interior.ColorIndex = xlNone '無色 End Select End If Next End Sub

  • VBAで別の列のセルにも色付け~2

    WINDOWS XP EXCELL 2003です。 いつもお世話になります。 ご迷惑とは重々と承知しながら再度質問させていただきます。 1 御指導を賜りたいのは、 現在A列には月度を示す 01~12 が入力され月別にセルの背景色を塗りつぶしていますがこれをA列用のマクロを工夫してF列にも同様に適用したい。 例えば参照図で言うと A7 05 ピンク  A8 05 ピンク A9 06 ライトブルー  A10 07 草色 等のように ※ 参照図のF列のセルには背景色は適用していません。 2 参照図のそれぞれの設定は、   ※ 計画 と 生産はセル位置だけの違いで生産の方は割愛します。 D1 ユーザー定義 mm/dd D2 ユーザー定義 200000 D3 数値 A7 ユーザー定義 mm マクロ ボタン「計画入力」 Sub 計画入力() Dim GYOU '追加 GYOU = Range("C65536").End(xlUp).Row + 1 Cells(GYOU, 2).Value = Range("D1").Value Cells(GYOU, 3).Value = Range("D2").Value Cells(GYOU, 4).Value = Range("D3").Value End Sub ボタン「セルセット」 Sub 計画セル()    Range("D1,D2,D3,D1").Select End Sub A列のセル塗りつぶし Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row >= 8 And Target.Address = Cells(Rows.Count, "C").End(xlUp).Address Then Target.Offset(0, 0).Value = Date End If Dim c As Integer If Target.Column <> 2 Then Exit Sub If Target.Value = "" Then c = 0 Else On Error GoTo line Select Case Month(Target.Value) Case 1: c = 46 Case 2: c = 4 Case 3: c = 39 Case 4: c = 6 Case 5: c = 7 Case 6: c = 8 Case 7: c = 43 Case 8: c = 3 Case 9: c = 44 Case 10: c = 24 Case 11: c = 40 Case 12: c = 17 End Select End If Target.Offset(0, -1).Interior.ColorIndex = c Target.Offset(0, -1).Font.ColorIndex = IIf(c = 1, 2, 0) Exit Sub line: Target.Offset(0, -1).Interior.ColorIndex = 0 Target.Offset(0, -1).Font.ColorIndex = 0 End Sub 御指導よろしく御願いします。

  • EXCEL セルをコピペすると画面がフリーズする

    お世話になります excelシート イベントでセルの値が変わった時にマクロが実行されるVBAを作成していて、 1行毎の入力作業はうまくいくのですが、式の入っていないセルを複数行をコピペ、 例えばA,Bセルの値が同じものが5件ほどあった場合、最初の入力のものをしたにドラッグして 貼り付けると、画面がフリーズして強制終了せざる負えなくなります。 エラーを回避する方法をご教示お願いいたします。以下VBAの内容です。 Dim sh1 As Worksheet Dim i As Integer Private Sub Worksheet_Calculate() 'detailに指標をセット i = 9 シートをworkエリアにセット Set sh1 = Worksheets(4) 'カードルシート,2ページ(予備)まで指標を回す For i = 9 To 66 '画面ちらつき防止 Application.ScreenUpdating = False '2ページ(予備)目ヘッダーは処理しない If i < 33 Or i > 41 Then 'サンプル番号が入力されている時 If sh1.Cells(i, "E") <> "" Then 'サンプル年月が入力されている時 If IsError(sh1.Cells(i, "K")) <> True Then '基準年月 >= サンプル年月 の時 If sh1.Cells(7, "O") >= sh1.Cells(i, "K") Then '次回サンプル年月 <= 当年月 の時 If sh1.Cells(i, "Q") <= sh1.Cells(8, "O") Then sh1.Cells(i, "M") = "出荷禁止" '該当行を赤色で塗りつぶし With sh1 .Cells(i, "A").Interior.ColorIndex = 3 .Cells(i, "B").Interior.ColorIndex = 3 .Cells(i, "C").Interior.ColorIndex = 3 .Cells(i, "D").Interior.ColorIndex = 3 .Cells(i, "E").Interior.ColorIndex = 3 .Cells(i, "F").Interior.ColorIndex = 3 .Cells(i, "G").Interior.ColorIndex = 3 .Cells(i, "H").Interior.ColorIndex = 3 .Cells(i, "I").Interior.ColorIndex = 3 .Cells(i, "J").Interior.ColorIndex = 3 .Cells(i, "K").Interior.ColorIndex = 3 .Cells(i, "L").Interior.ColorIndex = 3 .Cells(i, "M").Interior.ColorIndex = 3 End With Else '次回サンプル年月 <= 当年月 でない時 sh1.Cells(i, "M") = "OK" End If End If End If Else '該当行を無色で塗りつぶし With sh1 .Cells(i, "A").Interior.ColorIndex = 0 .Cells(i, "B").Interior.ColorIndex = 0 .Cells(i, "C").Interior.ColorIndex = 0 .Cells(i, "D").Interior.ColorIndex = 0 .Cells(i, "E").Interior.ColorIndex = 0 .Cells(i, "F").Interior.ColorIndex = 0 .Cells(i, "G").Interior.ColorIndex = 0 .Cells(i, "H").Interior.ColorIndex = 0 .Cells(i, "I").Interior.ColorIndex = 0 .Cells(i, "J").Interior.ColorIndex = 0 .Cells(i, "K").Interior.ColorIndex = 0 .Cells(i, "L").Interior.ColorIndex = 0 .Cells(i, "M").Interior.ColorIndex = 0 .Cells(i, "M") = "" End With End If End If Next i End Sub