【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?

sheet1に表を作成しました。
表のB列に「社員」「契約」「バイト」と入力、
C列には「業務I」「業務II」「業務III」「業務IV」と入力していきます。

  A  B   C    D
  No.  担当 業務  
1 1  社員 業務I
2 2  契約 業務II
3 3  バイト 業務III
4 4  契約 業務IV
5 5  社員 業務I
6 6  バイト 業務IV

入力することによりシートが増え、
行によってそれぞれ(業務)の書類とスケジュールが
表示されるようにしたいのですが、どうすればよろしいのでしょうか。

また、増えたシートの見出しの色を
業務Iは赤、業務IIは青、業務IIIは黄色と自動的に変わる
コードの記述方法を教えてください。

よろしくお願いいたします。

A 回答 (1件)

こんばんは!



>入力することによりシートが増え、
Excelは同一Sheet名はつけることができません。
>行によってそれぞれ(業務)の書類とスケジュールが
具体的にどのような書類か判断しかねますので、
勝手に↓のような解釈をしています。

画像では左側が入力用のSheet1で右側が「業務I」~「業務IV」のSheetとなります。
Sheet1のC列のデータを入力した段階でマクロが実行されるようにしています。
尚、Sheet1のA列「No」は入力済みだとします。

画面左下のSheet1にSheet見出し上で右クリック → コードの表示 → VBE画面のカーソルが点滅しているところに
↓のコードをコピー&ペースト → Sheet1の画面に戻りデータを入力してみてください。

Private Sub Worksheet_Change(ByVal Target As Range) 'この行から
Dim lastRow As Long, str As String, wS As Worksheet
If Intersect(Target, Range("C:C")) Is Nothing Or Target.Count > 1 Then Exit Sub
Set wS = Worksheets("Sheet1")
If Worksheets.Count < 6 Then
Do Until Worksheets.Count = 5
Worksheets.Add after:=Worksheets(Worksheets.Count)
Loop
With Worksheets(2)
.Name = "業務I"
.Tab.ColorIndex = 3
End With
With Worksheets(3)
.Name = "業務II"
.Tab.ColorIndex = 5
End With
With Worksheets(4)
.Name = "業務III"
.Tab.ColorIndex = 6
End With
With Worksheets(5)
.Name = "業務IV"
.Tab.ColorIndex = 4
End With
End If
lastRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
With Target
If .Offset(, -1) = "" Then
MsgBox "担当を入力"
.Offset(, -1).Select
Else
str = .Value
Worksheets(str).Range("A:C").ClearContents
wS.Range("A1").AutoFilter field:=3, Criteria1:=str
Range(wS.Cells(1, "A"), wS.Cells(lastRow, "C")).SpecialCells(xlCellTypeVisible).Copy _
Worksheets(str).Range("A1")
wS.AutoFilterMode = False
End If
End With
End Sub 'この行まで

※ 「業務IV」のSheet見出しの色は「薄い緑」にしています。
※ Sheet1のB・C列は入力規則のリストを設定しておけば
いちいち入力する手間は省けると思います。

的外れならごめんなさいね。m(_ _)m
「エクセルVBAのコード記述について教えて」の回答画像1
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!