| |
次のように登録のマクロを組みました。1.登録日と同じデータが当月シートにある場合警告メッセージ、2.当月シートにデータ張付が完了したら日付順に整列させるようにしたいのですが、うまくいきません。構文の不具合もあると思いますが、なかなか解決できません。詳しい方のご指導をお願いいたします。
Sub まとめて登録()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Set 登録 = Worksheets("登録")
月 = 登録.Cells(4, 18)
日 = 登録.Cells(4, 20)
区分 = 登録.Cells(7, 17)
人数 = 登録.Cells(7, 18)
あ = 登録.Cells(7, 19)
い = 登録.Cells(7, 20)
う = 登録.Cells(7, 21)
え = 登録.Cells(7, 22)
備考 = 登録.Cells(7, 23)
'最終行を取得（Q23から上方向に牽索）
最終行 = 登録.Range("Q23").End(xlUp).Row
Set 当月 = Worksheets("登録月" & 月)
縦 = 7
msg = MsgBox("入力内容を登録月" & 月 & "シートに転送します。" & vbCrLf & "よろしいですか？", vbOKCancel + vbExclamation, "入力内容の転送")
If msg = vbOK Then
If Worksheet.CountIf("当月.Range(当月.cells(7,20).vaiue:当月.cells(400,20).value", 登録.Cells(4, 20).valuw) ＜１ Then
msg = MsgBox("この日付データはすでに登録されています " vbOKonly + vbExclamation)
If msg = vbOK Then
For 行 = 7 To 最終行
Do Until 当月.Cells(縦, 20) = ""
縦 = 縦 + 1
Loop
当月.Cells(縦, 20) = 日
当月.Cells(縦, 21) = 区分
当月.Cells(縦, 22) = 人数
当月.Cells(縦, 23) = あ
当月.Cells(縦, 24) = い
当月.Cells(縦, 25) = う
当月.Cells(縦, 26) = え
当月.Cells(縦, 27) = 備考
For 横 = 17 To 23
当月.Cells(縦, 横 + 4) = Cells(行, 横)
Next
Next
With 登録
.Range(.Cells(5, 4), .Cells(10, 7)).ClearContents
.Range(.Cells(12, 4), .Cells(15, 7)).ClearContents
.Range(.Cells(17, 4), .Cells(24, 7)).ClearContents
.Range(.Cells(26, 4), .Cells(29, 7)).ClearContents
.Range(.Cells(5, 11), .Cells(12, 14)).ClearContents
.Range(.Cells(14, 11), .Cells(19, 14)).ClearContents
.Range(.Cells(21, 11), .Cells(26, 14)).ClearContents
.Range(.Cells(7, 18), .Cells(23, 18)).ClearContents
End With
MsgBox "データ転送が終了しました。", vbOKOnly + vbInformation, "終了"
Else: MsgBox "操作を中断しました"
Exit Sub
End If
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
Application.Calculate
Application.ScreenUpdating = True
End Sub
|
|
りんご
- 14/3/21(金) 0:03 -
