| |
あぁ・・そーいうことですか、分かりました。
ならば項目数が 4 であることを前提に、以下のマクロを各モジュールに入れ、
いったんブックを保存して閉じ、再度開いてから2006年度シートにデータを
入力してみて下さい。A:D列に間違いなく4つのデータを入れたとき、その月の
シートへ自動的に転記します。また、その際にコピー先で重複した値があれば、
メッセージを出してから入力したところをクリアして終わります。
[標準モジュール]
Sub Auto_Open()
Dim i As Integer
For i = 1 To 12
With Sheets(i & "月")
If Not IsEmpty(.Range("A2").Value) Then
.Range("AA:AA").ClearContents
.Range("A2", .Range("A65536").End(xlUp)) _
.Offset(, 26).Formula = "=CONCATENATE($A2,$B2,$C2,$D2)"
End If
End With
Next i
End Sub
[2006年度シートのシートモジュール]
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyR As Range
Dim Sn As String, CkSt As String
Dim MyV As Variant
With Target
If .Column <> 4 Then Exit Sub
If .Row = 1 Then Exit Sub
If IsEmpty(.Value) Then Exit Sub
With .Offset(, -3)
If Not IsDate(.Value) Then Exit Sub
Sn = Month(.Value) & "月"
Set MyR = .Resize(, 4)
End With
End With
With Application
If .CountA(MyR) < 4 Then
MsgBox "A" & .Row & ":D" & .Row & _
" に未入力のセルがあります", 48
Set MyR = Nothing: Exit Sub
End If
MyV = .Transpose(.Transpose(MyR.Value))
CkSt = Join(MyV, "")
If Not IsError(.Match(CkSt, Sheets(Sn).Range("AA:AA"), 0)) Then
MsgBox "そのデータは既にコピー済みです", 48
.EnableEvents = False
MyR.ClearContents
.EnableEvents = True
Else
MyR.Copy Sheets(Sn).Range("A65536").End(xlUp).Offset(1)
End If
End With
Set MyR = nothing
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 06/5/25(木) 13:50 -
