• ベストアンサー
※ ChatGPTを利用し、要約された質問です(原文:VBAで作業を作成したものを別の列に適用するには)

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

このQ&Aのポイント
  • VBAを使って作成した作業を別の列にも適用したいです。具体的には、「KとL」「MとN」の列に同じ処理をしたい場合について教えてください。
  • 作成したVBAは、I列に文字が入力されるとJ列に明日の日付が自動で入力されるようになっています。また、IとJのセルには色がつけられます。
  • ループ処理を試しましたが、行に関連する処理を理解することができませんでした。どのようにすれば同じ処理が「KとL」「MとN」にも適用できるのか教えてください。

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

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

下記でお望の事が可能かと思います。 ご確認下さい。 Private Sub Worksheet_Change(ByVal Target As Range) With Target If Application.Intersect(Range("I1:I100, K1:K100, M1:M100"), 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, K:K, M:M"), 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, c.Column).Resize(1, 2).Interior.ColorIndex = myColor Next c Application.EnableEvents = True End Sub

avippa
質問者

お礼

ありがとうございます。 やりたい事が実行できました。 これからも頑張って勉強したいと思います。

すると、全ての回答が全文表示されます。

関連するQ&A

このQ&Aのポイント
  • プライベートホームページに接続できない問題が発生。
  • FTP over Explicit SSL/TLS (FTPES) に変更後の接続エラー。
  • Windows10及びWindows11で同様のエラーが確認されている。
回答を見る

専門家に質問してみよう