Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


6927 / 76736 ←次へ | 前へ→

【75405】[無題]
質問  りんご E-MAIL  - 14/3/21(金) 0:03 -

引用なし
パスワード
   次のように登録のマクロを組みました。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) <1 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
0 hits

【75405】[無題] りんご 14/3/21(金) 0:03 質問
【75410】Re:[無題] マナ 14/3/21(金) 13:38 発言
【75416】Re:[無題] りんご 14/3/22(土) 8:54 お礼
【75442】Re:[無題] マナ 14/3/27(木) 21:02 発言
【75443】Re:[データがないときの処理] りんご 14/3/28(金) 13:05 質問
【75444】Re:[データがないときの処理] マナ 14/3/28(金) 19:21 発言

6927 / 76736 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free