高速処理ができるようにしたのはいいのですが、マウスポインタの砂時計がクリックしないと矢印に戻りません。自分のパソコンでは、クリックしないで戻るのですが。会社のパソコンだとできません。スッペクの良し悪しなのか、スペックに関係なくクリックしないで矢印に戻る解決方法があればお願いします。(コードは下記です。) Windows7 Office2010 Private Sub 定義の書込_Click() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Dim ret As Integer ret = MsgBox("メインシートのデータを、" & ActiveSheet.Range("C54").Value & "の勤務表に" _ & "書き込みます。 よろしいですか？", _ vbOKCancel + vbQuestion, "メイン・2") Select Case ret Case vbOK UserForm2.Show vbModeless UserForm2.Repaint Dim i As Integer Dim j As Integer For i = 1 To 16 For j = 1 To 31 Dim addrname_workpattern As String addrname_workpattern = "" With Worksheets("メイン") Select Case .Cells(9 + (i - 1) * 2, 10 + (j - 1) * 3).Value Case 1: addrname_workpattern = "勤務1" Case 2: addrname_workpattern = "勤務2" Case 3: addrname_workpattern = "勤務3" Case 4: addrname_workpattern = "日勤1" Case 5: addrname_workpattern = "日勤2" Case 6: addrname_workpattern = "日勤3" Case Else Select Case .Cells(10 + (i - 1) * 2, 9 + (j - 1) * 3).Value Case 1: addrname_workpattern = "日勤4" Case Else Select Case .Cells(9 + (i - 1) * 2, 9 + (j - 1) * 3).Value Case 2: addrname_workpattern = "明け" Case 3: addrname_workpattern = "日勤" Case 4: addrname_workpattern = "夜勤" Case 5: addrname_workpattern = "公" Case 6: addrname_workpattern = "有" Case 7: addrname_workpattern = "特" Case 8: addrname_workpattern = "振" Case 9: addrname_workpattern = "欠" End Select End Select End Select End With If addrname_workpattern <> "" Then ActiveSheet.Range(addrname_workpattern).Copy Cells(7 + i, 5 + (j - 1) * 3).PasteSpecial Application.CutCopyMode = False End If Next Next Unload UserForm2 Range("E10:CS10").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("E34:CS34").Select Selection.Delete Shift:=xlUp Macro9 Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Select End Sub
↧