Excelでポイントの管理表を作成したいです。 個人ごとにシートを作成し、発行者のシートでポイントを

Excelでポイントの管理表を作成したいです。
個人ごとにシートを作成し、発行者のシートでポイントを入力すると自動的に受領者のシートにポイントが反映され、蓄積されていく仕様にしたいのですが、それに適した関数またはマクロはありますでしょうか？希望の仕様としては1枚のシートに発行欄と受領欄があり、Aさんのシートの発行欄でBさんに1ポイントの入力をするとBさんのシートの受領欄にAさんから1ポイント入ったということが分かるようにしたいです。

質問者からの補足コメント

• 希望はこのようにしたいと考えています。A、Bのシートの仕様は同じで、A.Bの他にC.D.Eと、シートは全部で5枚作成したいです。

  
    補足日時：2023/08/22 17:28

• 受領者Aと受領者Bのレイアウトは同じです。

  
    補足日時：2023/08/22 17:36

No.3 回答者： 銀鱗 回答日時： 2023/08/22 17:33

(`・ω・´) Excel じゃなくて Access でやる案件ですね。

・・・それでもアドバイス・・・

普通に入力フォームを使えば良い。
そんだけの話。

No.2 回答者： tatsumaru77 回答日時： 2023/08/22 17:20

①発行者Aさんのシートのレイアウトが判る画像

②受領者Bさんのシートのレイアウトが判る画像
を提示していただけると良い回答がつくかと。
①と②のレイアウトが同じ場合は、その旨明記して、①のみ提示してください。

No.1 回答者： 河内のおやじ 回答日時： 2023/08/22 17:11

Sub ポイントを反映()

Dim ws発行 As Worksheet
Dim ws受領 As Worksheet
Dim 発行者 As String
Dim ポイント As Double

' 発行者のシートを参照
Set ws発行 = ThisWorkbook.Sheets("発行者のシート")

' 発行者の名前とポイント数を取得
発行者 = ws発行.Range("A1").Value
ポイント = ws発行.Range("B1").Value

' 受領者のシートを参照（発行者の名前と同じ名前のシートを想定）
On Error Resume Next
Set ws受領 = ThisWorkbook.Sheets(発行者)
On Error GoTo 0

' 受領者のシートが存在すればポイントを反映
If Not ws受領 Is Nothing Then
' 現在のポイントを取得
受領者ポイント = ws受領.Range("B1").Value

' ポイントを加算
ws受領.Range("B1").Value = 受領者ポイント + ポイント

' 履歴を記録（新しい行に追加）
LastRow = ws受領.Cells(ws受領.Rows.Count, "C").End(xlUp).Row + 1
ws受領.Cells(LastRow, "C").Value = "受領：" & Format(Now, "yyyy/mm/dd hh:mm:ss") & " - " & ポイント & " ポイント"
Else
MsgBox "受領者のシートが見つかりません。"
End If
End Sub