##ユーザーシートのグループ名列にグループシートのグループ名が追加された場合、
グループシートの対象のグループ列へユーザーシートA列の名前を入れる。
Sub UpdateGroups()
Dim wsUser As Worksheet
Dim wsGroup As Worksheet
Dim lastRowUser As Long
Dim lastRowGroup As Long
Dim i As Long, j As Long
Dim userName As String
Dim groupName As String
Dim groupFound As Boolean
Dim errorMsg As String
Dim updateCount As Long
On Error GoTo ErrorHandler
' シートを設定
Set wsUser = ThisWorkbook.Sheets("ユーザー")
Set wsGroup = ThisWorkbook.Sheets("グループ")
' ユーザーシートの最終行を取得
lastRowUser = wsUser.Cells(wsUser.Rows.Count, 1).End(xlUp).Row
updateCount = 0
' 各ユーザーを確認
For i = 2 To lastRowUser ' 2行目から開始
userName = wsUser.Cells(i, 1).Value
groupName = wsUser.Cells(i, 2).Value
groupFound = False
' グループシートの最終行を取得
lastRowGroup = wsGroup.Cells(wsGroup.Rows.Count, 1).End(xlUp).Row
' グループシート内で一致するグループ名を検索
For j = 2 To lastRowGroup ' 2行目から開始
If wsGroup.Cells(j, 1).Value = groupName Then
' 一致するグループが見つかった場合、次の空セルに名前を追加
wsGroup.Cells(j, wsGroup.Columns.Count).End(xlToLeft).Offset(0, 1).Value = userName
groupFound = True
updateCount = updateCount + 1
Exit For
End If
Next j
' グループが見つからない場合
If Not groupFound Then
errorMsg = errorMsg & "行 " & i & ": グループ '" & groupName & "' が見つかりませんでした。" & vbCrLf
End If
Next i
' 正常完了のメッセージ
MsgBox updateCount & " 件のユーザーが正常に更新されました。", vbInformation
' エラーメッセージがある場合に表示
If Len(errorMsg) > 0 Then
MsgBox "以下のエラーが発生しました:" & vbCrLf & errorMsg, vbExclamation
End If
Exit Sub
ErrorHandler:
MsgBox "エラーが発生しました: " & Err.Description, vbCritical
End Sub
- ボタンを配置
- 「開発」タブをクリックし、ツールバーの「挿入」グループで「フォームコントロール」内の「ボタン(フォームコントロール)」をクリックします。
- シート上でボタンを配置したい場所をクリックし、ドラッグしてボタンを描きます。
- マクロの割り当て
- ボタンを配置すると、「マクロの登録」ダイアログが表示されます。
- 表示された「UpdateGroups」を選択し、「OK」をクリックします。
- ボタンの名前を変更
- ボタンに「ボタン 1」などのデフォルト名が表示されている場合、右クリックして「テキストの編集」を選択し、好きな名前(例:「グループ更新」)に変更します。