D2に入力、B2に今日の日付のVBAを追加したいが| OKWAVE

日付を入力すると何故か今日の日付に

いつもお世話になります。 WINDOWS7 EXCELL2010 です。参照図で言うと、 B2 に例えば　1/4　と入力すると　今日の日付になります。何故なんでしょうか。影響しているのかどうかわかりませんが参考に下記のようなコードを使用しています。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row >= 2 And Target.Address = Cells(Rows.Count, "C").End(xlUp).Address Then Target.Offset(0, -1).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

VBAでセルの色付を別の列にも追加するには

WINDOWS XP EXCELL ２００３です。いつもお世話になります。現在下記の如く、 A列にマクロを設定しています。 ※A F列には下記の数式が入っています。 A2 =IF(B2="","",TEXT(B2,"mm")) F2 =IF(G2="","",TEXT(G2,"mm")) Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row >= 2 And Target.Address = Cells(Rows.Count, "C").End(xlUp).Address Then Target.Offset(0, -1).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 上記のマクロに追加でF列にも同様にセルの色付けするにはどうすればいいかご教授を御願いできないでしょうか。

VBAの記録を追加したい

エクセル2002使用です。 VBAで次のコードを使っています。 Private Sub Worksheet_Change(ByVal Target As Range) Dim Rng As Range Set Target = Intersect(Range("C:C"), Target) If Target Is Nothing Then Exit Sub For Each Rng In Target If Rng.Value <> "" Then Rng.Offset(, -2).Value = Now Else ' (*) Rng.Offset(, -2).Value = "" ' (*) End If Next Rng End Sub （C列のセルに何か入力されると、A列の同じ行にその時刻が入る。）同じシートで、F列に何か入力されるとE列の同じ行にその時刻が入るように書き直したいのですが、どうすればいいのでしょうか？すいませんが、よろしくお願いします。

excel BVでTarget.Offset

勤務表を作成しています。勤務「Ｃ」の翌日は「休」にするところまでは出来たのですが、「Ｃ」が連続する日は「休」も連続させたいのです。例）３日と４日が「Ｃ」の時は、５日、６日は連休にしたいのですが、作った下のマクロでは７日も「休」になってしまいます。何が間違ってるんでしょうか？。 If Target.Count > 1 Then Exit Subの意味も良く解っていませんが…。どなたか教えてください。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Target.Value = "Ｃ" Then Target.Offset(0, 1).Value = ("休") End If If Target.Offset(0, -2).Value = "Ｃ" Then Target.Offset(0, 1).Value = ("休") End If End Sub

右クリック、ダブルクリックの操作

勤務表作成してます。 A1に「ON・OFF」を表示します。「ON」のときに、ダブルクリックで、上のセルを表示、右クリックで「１」を表示します。「OFF」のときは、コンテキストメニュ-(通常の操作)が出来るようにしたいのですが、ON.OFFの切り替え操作のVBAがわかりません。よろしくお願いします。 Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) ' ActiveCell = ActiveCell.Offset(-1, 0).Value ' ' If Target = Range("$A$1") Then ' Cancel = True If Range("$A$1").Value = "イベントON" Then Range("$A$1").Value = "イベントOFF" Else Range("$A$1").Value = "イベントON" ActiveCell = ActiveCell.Offset(-1, 0).Value Exit Sub End If Cancel = True If Range("$A$1").Value = "イベントOFF" Then Exit Sub End If End Sub Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) 'ActiveCell = "1" ' If Target = Range("$A$1") Then ' Cancel = True ' If Range("$A$1").Value = "イベントON" Then ' Range("$A$1").Value = "イベントOFF" If Range("$A$1").Value = "イベントON" Then ActiveCell = "1" Else: Range("$A$1").Value = "イベントOFF" Exit Sub End If Cancel = True If Range("$A$1").Value = "イベントOFF" Then Exit Sub End If End Sub

VBAで別の列のセルにも色付け～２

WINDOWS XP EXCELL ２００３です。いつもお世話になります。ご迷惑とは重々と承知しながら再度質問させていただきます。１　御指導を賜りたいのは、現在A列には月度を示す　０１～１２　が入力され月別にセルの背景色を塗りつぶしていますがこれをA列用のマクロを工夫してF列にも同様に適用したい。例えば参照図で言うと A７　０５　ピンク　 A８　０５　ピンク A９　０６　ライトブルー　 A１０　０７　草色　等のように ※ 参照図のF列のセルには背景色は適用していません。２　参照図のそれぞれの設定は、　　 ※ 計画　と　生産はセル位置だけの違いで生産の方は割愛します。 D１　ユーザー定義　mm/dd D２　ユーザー定義　２０００００ D３　数値 A７　ユーザー定義　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 御指導よろしく御願いします。

セルに文字を入力したら今日の日付が

いつもお世話になります。 Windows XP EXCELL2003 下記のようなマクロを設定しています。この場合は　C2(顧客ID 例:001) に文字が入力されると　B2 に今日の日付が入ります。この場合、２行目の１行しか適用できません。 C3 B3に C4 B4に C5 B5にという具合に最終行に適用してゆくにはマクロをどうすればいいかご指導いただけませんか。宜しく御願いします。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$C$2" Then Target.Offset(0, -1).Value = Date End If End Sub

ダブルクリック・右クリックの操作方法

勤務表作成してます。 A1に「ON・OFF」を表示します。「ON」のときに、ダブルクリックで、上のセルを表示、右クリックで「１」を表示します。「OFF」のときは、コンテキストメニュ-(通常の操作)が出来るようにしたいのですが、ON.OFFの切り替え操作のVBAがわかりません。よろしくお願いします。 Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) ActiveCell = ActiveCell.Offset(-1, 0).Value If Target = Range("$A$1") Then Cancel = True If Range("$A$1").Value = "イベントON" Then Range("$A$1").Value = "イベントOFF" Else Range("$A$1").Value = "イベントON" End If If Range("$A$1").Value = "イベントOFF" Then Exit Sub End If End If End Sub Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) ActiveCell = "1" ' If Target = Range("$A$1") Then ' Cancel = True ' ' If Range("$A$1").Value = "イベントON" Then ' Range("$A$1").Value = "イベントOFF" ' Else ' Range("$A$1").Value = "イベントON" ' End If If Range("$A$1").Value = "イベントOFF" Then Exit Sub End If End Sub

ドラッグした際のエラー回避

以下のようなVBAを組んだのですが、オートフィルタでV列をリストのいずれかを選択中にドラッグすると「型が一致しません」というエラーを起こします。最悪、オートフィルタ中はドラッグ不可でもかまいません。ご教授ください。（WiｎXp/Access2003) Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) '列の色変更 Dim myColor As Variant Dim myFontColor As Variant If Target.Column = 1 Then GoTo S If Target.Column = 9 Then GoTo K If Target.Column = 25 Then GoTo Y If Target.Column = 22 Then GoTo A If Selection.Cells.Count > 1 Then Exit Sub Exit Sub S: 'A列入力時 If Not Intersect(Target, Range("A1:A10")) Is Nothing Then Exit Sub Application.EnableEvents = False If Target.Value <> "" And Target.Offset(0, 4) = "" And Target.Offset(0, 2) = "" Then Target.Offset(0, 2) = "TypeA" Target.Offset(0, 5) = "未" Target.Offset(0, 6) = Date Target.Offset(0, 1).Select End If Application.EnableEvents = True Exit Sub K: '故障入力時 If Not Intersect(Target, Range("K1:K10")) Is Nothing Then Exit Sub Application.EnableEvents = False If Target.Value = "Y" Then Target.Offset(0, 13) = "故障" Cells(Target.Row, 1).Resize(1, 28).Interior.ColorIndex = 7 Target.Offset(0, 1).Select Else End If Application.EnableEvents = True Exit Sub Y: 'Y列入力時 If Not Intersect(Target, Range("Y1:Y10")) Is Nothing Then Exit Sub Application.EnableEvents = False If Target.Value <> "" And Target.Offset(0, 1) = "" And Target.Offset(0, 2) = "" Then Target.Offset(0, -3) = "売却済" Target.Offset(0, 1) = Date Target.Offset(0, 2) = "未" Cells(Target.Row, 1).Resize(1, 28).Interior.ColorIndex = 16 Else End If Application.EnableEvents = True Exit Sub A: If Not Intersect(Target, Range("A1:AB10")) Is Nothing Then Exit Sub Application.EnableEvents = False Select Case Target.Value Case "故障" myColor = 7 'ピンク myFontColor = 1 Case "修理中" myColor = 37 '薄い水色 myFontColor = 1 Case "担当出(1)" myColor = 3 '赤 myFontColor = 1 Case "担当出(2)" myColor = 8 '水色 myFontColor = 1 Case "担当出(3)" myColor = 4 '蛍光緑 myFontColor = 1 Case "担当出(4)" myColor = 6 '黄色 myFontColor = 1 Case "担当出(5)" myColor = 5 '青 myFontColor = 1 Case "担当出(6)" myColor = 10 '深緑色 myFontColor = 1 Case "売却済" myColor = 16 '濃灰色 myFontColor = 1 Case "廃棄", "修理不可能" myColor = 47 '群青 myFontColor = 2 '白 Case "保守用" myColor = 49 '群青 myFontColor = 2 '白 Case Else myColor = xlNone End Select Cells(Target.Row, 1).Resize(1, 28).Interior.ColorIndex = myColor Cells(Target.Row, 1).Resize(1, 28).Font.ColorIndex = myFontColor Application.EnableEvents = True End Sub Private Sub AFall() If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData End If End Sub

マクロでのタイトル行の変更

いつもお世話になります。添付の画像で　タイトル　行で上側で　　氏名　登録日　No　は下記のようなマクロが入っています。 Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo Error If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub If Target.Offset(0, -1).Value = "" Then Exit Sub If Target.Value <> "" Then Target.Offset(0, 1).Value = Application.Max(Range("C:C")) + 1 End If Error: End Sub 添付の下のように　No　登録日　氏名　のように位置を変更は上のマクロのどの部分を変更すればいいかご教示願えませんか。宜しく御願いします。色々と試したのですが分からなくなりました。

VBAで作業を作成したものを別の列に適用するには

教えてください。マクロ初心者ですが、色々なところから検索してI列に文字が入力されるとJ列に自動で明日の日付が入るようにまた、入力したIとJのセルを色つけまで完成させました。次の列以降にも同じ作業を行いたいときのVBAを教えてください。（「KとL」「MとN」に同じ処理をしたい場合）ループ処理など見たのですが、行のようでよくわかりませんでした。ちなみに作成したVBAがこちらです。 Private Sub Worksheet_Change(ByVal Target As Range) With Target If Application.Intersect(Range("I1:I100"), Target) Is Nothing Then Exit Sub If .Count > 1 Then Exit Sub If IsEmpty(.Value) Then .Offset(, 1).ClearContents Else .Offset(, 1).Value = Date+1 End If End With Dim myColor As Variant Dim c As Range Dim myRng As Range Set myRng = Application.Intersect(Range("I:I"), Target) If myRng Is Nothing Then Exit Sub Application.EnableEvents = False For Each c In myRng Select Case c.Value Case 1 myColor = 36 Case 2 myColor = 38 Case 3 myColor = 40 Case 4 myColor = 39 Case 5 myColor = 34 Case 6 myColor = 35 Case Else myColor = xlNone End Select Cells(c.Row, 9).Resize(1, 2).Interior.ColorIndex = myColor Next c Application.EnableEvents = True End Sub よろしくお願いします。

VBA/エクセルの日付入力でYYYYMMDD

エクセル2013です。特定のセルに日付を入力してもらうのですが、人によりさまざまな入力をされてしまいます。どんな入力でも日付であれば、シリアル値なのであとからなんとかなるのですが、困るのはYYYYMMDDの連続数字、例えば今日なら20140712と入力されてしまうことです。入力規則で排除したいのですが、それは許されず、20140712も日付として扱わなければならなくなりそうです。そこでマクロで対処しようと以下のコードを書きました。 Private Sub Worksheet_Change(ByVal Target As Range) 　　Select Case Target.Address(0, 0) 　　　　Case "D2", "F2", "C4" 　　　　　　If Target.Value = "" Then Exit Sub 　　　　　　If IsDate(Target.Value) Then 　　　　　　　　Target.NumberFormatLocal = "yyyy/m/d" 　　　　　　Else 　　　　　　　　Application.EnableEvents = False 　　　　　　　　Target.Value = CDate(Format(Target.Value, "@@@@/@@/@@")) 　　　　　　　　Application.EnableEvents = True 　　　　　　End If 　　　　Case Else 　　　　　　Exit Sub 　　End Select End Sub これで最初はうまくいき、20140712と入力されても、ちゃんと2014/7/12になります。ところが、同じセルに再度YYYYMMDD数字形式で入力すると、実行時エラー「オーバーフローしました」になってしまいます。多分セルが、YYYYMMDDの数字をシリアル値として見てありえない日付と判断したのだと思います。どのようにコードを修正したらよろしいでしょうか？もう1点、日付をYYYYMMDDの連続数字で入力することは普通、エクセルではあまり見たことないですが、これって一般的な方法なのでしょうか？

エクセルのマクロ設定について

クリックすると、日付が表示されるように、下記のマクロ設定してあります。 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Range("C4:C30")) Is Nothing Then Exit Sub If ActiveCell = "" Then ActiveCell = Date Cancel = True End If End Sub C4~C30とG4~G30の２箇所にしたいのですが、式はどうしたらいいのでしょうか。よろしくお願いします。

VBAでキャンセルしたときの構文は

いつもお世話になりります。 WIN7 エクセル2010　です。次のようなマクロがあります。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$C$10" Then Target.Offset(-6, 2).Value = Date End If If Target.Address = "$C$10" Then ActiveSheet.Tab.ColorIndex = 49 End If End Sub この場合、　C10　をクリアーした時　「G4(-6,2)の日付　と　シートタブの色」の両方をクリアーすることも可能でしょうか。もし可能ならばご指導願えませんか。

入力した日付の表示

このコーナーを閲覧して勉強をさせていただいています。Ａ１に文字を入力すると、その日付を表示させるにはという質問に対して、次のような回答がありました。早速利用させて貰おうかと思っているのですが、これで、任意の場所（Ｈ１）に表示させるにはどうしたらいいのでしょうか。 Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$A$1" Then Exit Sub Target.Offset(1).Value = Date End Sub 横から口を出すような格好になってすみません。

Excel VBA 入力規則

入力規則を利用して、３つのセルを連携させることを考えていますが、不適合な値を張り付けらられた場合に拒否をする方法があるのでしょうか。 Private Sub Worksheet_Change(ByVal Target As Range) Dim ad As String Dim ma As Range Dim ma2 As Range Dim r As Range Dim r2 As Range Dim r3 As Range Dim r1 As Range Dim m As Long Dim m2 As Long Application.EnableEvents = False If Target = "" Then Range("F7").Validation.Delete Range("F7") = "" If Target.Address(0, 0) = "B7" Then Range("D7").Validation.Delete Range("D7") = "" End If GoTo EXIT_SUB End If With Worksheets("Sheet1") ad = "A4" Set r = .Range(ad) Set ma = r.MergeArea Set r1 = r.Offset(0, 1) m = Application.Match(Range("B7"), .Range(r1, .Cells(r.Row + ma.Count - 1, r1.Column)), 0) Set r2 = .Cells(r.Row + m - 1, r1.Column) Set ma2 = r2.MergeArea If Target.Address(0, 0) = "B7" Then If ma.MergeCells Then setValiS Target.Offset(0, 2), r2 Range("F7").Validation.Delete Target.Offset(0, 2) = "" Target.Offset(0, 4) = "" Else MsgBox "A列が連結されていません。" End If ElseIf Target.Address(0, 0) = "D7" Then Set r3 = r2.Offset(0, 1) m2 = Application.Match(Target, .Range(r3, .Cells(r2.Row + ma2.Count - 1, r3.Column)), 0) setValiS Target.Offset(0, 2), .Cells(r2.Row + m2 - 1, r3.Column) Target.Offset(0, 2) = "" End If End With EXIT_SUB: Application.EnableEvents = True End Sub Sub setVali2() Dim tc As Range Dim c As Range Set tc = Worksheets("登録").Range("D3") Set c = Worksheets("Sheet1").Range("C3") setValiS tc, c End Sub Sub setValiS(tc As Range, c As Range) Dim ss As String Debug.Print tc.Address, c.Address ss = getChildren(c) If ss > "" Then With tc.Validation .Delete .Add Type:=xlValidateList, Formula1:=getChildren(c) End With End If Worksheets("登録").Activate End Sub Function getChildren(c As Range) Dim c1 As Range Dim ss As String Dim s1 As String Worksheets("Sheet1").Activate ss = "" For Each c1 In c.MergeArea s1 = c1.Offset(0, 1) If s1 <> "" Then ss = ss & "," & s1 Next c1 If ss <> "" Then ss = Mid(ss, 2) Else MsgBox "データがありません！" End If getChildren = ss End Function Sub Outline() Dim CheckRow As Long Dim Moji As String Dim TopRow As Long Dim EndRow As Long With ActiveSheet .Range("A2").ClearOutline .Outline.SummaryRow = xlAbove CheckRow0 = .Range("A" & .Rows.Count).End(xlUp).Row CheckRow = CheckRow0 Do If Moji = "" Then Moji = .Cells(CheckRow, 1).Value EndRow = CheckRow ElseIf yy_mm(CDate(.Cells(CheckRow, 1).Value)) = yy_mm(CDate(Moji)) Then TopRow = CheckRow If TopRow = 1 Then .Rows(TopRow + 1 & ":" & EndRow).Rows.Group Exit Do End If Else .Rows(TopRow + 1 & ":" & EndRow).Rows.Group CheckRow = CheckRow + 1 Moji = "" End If CheckRow = CheckRow - 1 Loop Until CheckRow = 1 .Rows(CheckRow + 1 & ":" & EndRow).Rows.Group .Outline.ShowLevels RowLevels:=1 ExecuteExcel4Macro "SHOW.DETAIL(1," & CheckRow0 & ",TRUE)" End With End Sub Function yy_mm(d As Date) yy_mm = Format(d, "yy/mm") End Function

エクセルVBAで指定したセルへジャンプするコード(追加の追加質問です)

http://oshiete1.goo.ne.jp/qa2903797.html たびたびすみません。最後にひとつだけお願いします。お教えいただいた下のコードは順調に動作するのですが、対象セルが結合セルの場合、エラーが出てしまいます。とまってしまうコードの部分は With Selection.AddComment です。エラーメッセージにはプロシージャの呼び出し、または引数が不正です。(Error 5)と書いてあります。結合セルは動作しないものでしょうか？ Sub test01() Dim x As String Dim ThisSheet_Name As String Dim Sheet_Name As String Dim Range_Name As String Dim I As Integer, n As Integer Dim Ans As Integer Dim myComment As String '新規追加 Dim Colors As Integer '新規追加 ThisSheet_Name = ActiveSheet.Name '設定シート Select Case Workbooks.Count Case 1 MsgBox "チェックするファイルがありません。" Exit Sub Case 2 For n = 1 To 2 If Workbooks(n).Name <> ThisWorkbook.Name Then x = Workbooks(n).Name '開いている“もうひとつのブック”の名前 End If Next Case Else MsgBox "他に開いているファイルが複数のため対象を特定できません。" Exit Sub End Select I = 0 Do While (1) With ThisWorkbook.Sheets(ThisSheet_Name) If .Range("A3").Offset(I, 0).Value = "" Then MsgBox "検査項目は以上です。" ThisWorkbook.Activate Exit Do 'A列の３行目以下が、空白なら終わる End If Sheet_Name = .Range("A3").Offset(I, 0).Value Range_Name = .Range("B3").Offset(I, 0).Value myComment = .Range("C3").Offset(I, 0).Value End With Windows(x).Activate Sheets(Sheet_Name).Select Range(Range_Name).Select Colors = Selection.Interior.ColorIndex '新規追加 Selection.Interior.ColorIndex = 6 With Selection.AddComment .Visible = True .Text myComment End With Range(Range_Name).Select Ans = MsgBox("「次をチェックしますか？」", vbYesNo) Selection.Interior.ColorIndex = Colors '修正 Selection.ClearComments '新規追加 If Ans = vbYes Then I = I + 1 Else Exit Do End If Loop End Sub

マクロ実行後に操作を元に戻したい

自作の時間割変更プログラムを使っています。次のマクロを何度か実行した後に一つずつ元に戻したいのですが。 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Rng As Range Dim m, n, s On Error Resume Next If Selection.Count <> 2 Then Exit Sub m = ActiveCell.Value n = ActiveCell.Interior.ColorIndex For Each Rng In Selection If Rng.Address <> ActiveCell.Address Then ActiveCell.Value = Rng.Value ActiveCell.Interior.ColorIndex = Rng.Interior.ColorIndex Rng.Value = m Rng.Interior.ColorIndex = n End If Next Rng End Sub 時間割のコマを移動した後に間違いが見つかり、間違いの時点まで元に戻して訂正したいのですが、Ctrl+zがきかず困っています。 Excel 365、windows 10を使用しています。どうにかなりませんか？

Worksheet_Changeが動かない

エクセル自動実行のマクロを作成中にうまく動かないのでサンプルをコピーして、変更してみたのですがそのサンプルも動いません、マクロとは違う何か悪いのでしょうか？ Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Dim intColor As Integer If Target.Count > 1 Then Exit Sub If Intersect(Target, Range("B2:B11")) Is Nothing Then Exit Sub Select Case Target.Value Case Is <= 20 intColor = 3 Case 21 To 40 intColor = 46 Case 41 To 60 intColor = 9 Case 61 To 80 intColor = 10 Case Is > 80 intColor = 5 End Select Target.Font.ColorIndex = intColor Application.EnableEvents = True End Sub

VBAによる数字入力で文字列表示

いつもお世話になります。 WIN7 EXCELL2010です。一つのシートに４ヶ月分があって合計３つのシートがあります。１月のみの記入するところのマクロは下記のマクロのように何とか作成しました。一つのシートでRangeが４ヶ所に分かれている場合で B6:B8(下記のマクロ) B18:AF20 B30:AF32 B B42:AF44 ですが下記のマクロをどう変えればベストかを誠に申し訳ありませんがご指導いただけないでしょうか。 Private Sub Worksheet_Change(ByVal Target As Range) With Target If Intersect(Target, Range("B6:AF8")) Is Nothing Then Exit Sub .Font.ColorIndex = 0 Application.EnableEvents = False Select Case .Value Case 0: .Value = Empty Case 1 To 3 .Value = Choose(.Value, "営業", "休日", "特休") Case 4 To 9 .Value = Choose(.Value - 3 , "出勤",”代休”,”有給”,”休出”,”遅刻”,”早退”) End Select Application.EnableEvents = True End With End Sub

D2に入力、B2に今日の日付のVBAを追加したいが

みんなの回答

補足 2013/06/14 15:51

関連するQ&A