1

従業員の勤務時間を記録するテンプレートがあります。列 5 はその週の契約時間を示し、列 14 は追加の勤務時間を示します。パートタイム スタッフ (1 週間あたり 37.5 時間未満) で追加の時間勤務する場合は、標準料金が支払われます。ただし、週に 37.50 時間を超えると、1.5 時間で支払われます (これは別の列に記録されます)。

以下のコードは、1 週間の合計時間数 (列 18) を取得し、それが 37.5 を超える場合、時間の一部を 1.5 時間記録するようにユーザーに促します。これは、人々が正しく支払われることを保証するフェイルセーフな方法です。

以下のコードはほぼ完全に機能しますが、契約時間が 10 時間未満の場合、関係なくメッセージ ボックスが表示されます。コードの時間の文字列データ型が文字列としてあるためだと思いますが、他のデータ型で動作させることができないようです。どんな援助でも大歓迎です。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Column = 14 Then

Dim I As Integer, CheckHours As Boolean
Dim MonthX As Worksheet
I = 6
CheckHours = False
Set MonthX = ThisWorkbook.ActiveSheet

Dim FT As String
FT = 37.5

Application.ScreenUpdating = False

'Use the Employee Number column to perform the check
Do While MonthX.Cells(I, 3) <> ""

    'Declare variables
        Dim ContractHours As String
        Dim HoursPaid As String
        Dim TotalHours As String

        ContractHours = MonthX.Cells(I, 5)     
        HoursPaid = MonthX.Cells(I, 14)
        TotalHours= MonthX.Cells(I, 18)

            'If the contract hours plus the additional hours are greater than 37.50 then display warning
            If TotalHours > FT Then
                MsgBox "WARNING: Check the additional hours entered for " & _
                MonthX.Cells(I, 2).Value & " " & MonthX.Cells(I, 1).Value & _
                " as they will need to be split between Additional Basic and Overtime." & _
                vbNewLine & vbNewLine & _
                "Please refer to the Additional Hours Guidelines tab for more information.", vbOKOnly, "Please Check"

                CheckHours = True

            End If

    I = I + 1
Loop

'Cancel boolean
If CheckHours = True Then
    Cancel = True
    End If

Application.ScreenUpdating = True

End If

End Sub
4

3 に答える 3

1

あなたのロジックが正しいかどうかはわかりませんが、コードと同じことを行う書き直しを次に示します。あなたのコードには目的がないように見える余分なものがたくさんあるので、私はそれを削除しました。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

   Dim i As Long
   Dim dTotalHours As Double
   Dim aMsg(1 To 5) As String

   Const dFULLTIME As Double = 37.5

   i = 6

   If Target.Column = 14 Then
      Do While Len(Me.Cells(i, 3).Value) > 0
         dTotalHours = Me.Cells(i, 18).Value
         If dTotalHours > dFULLTIME Then
            aMsg(1) = "WARNING: Check the additional hours entered for"
            aMsg(2) = Me.Cells(i, 2).Value
            aMsg(3) = Me.Cells(i, 3).Value
            aMsg(4) = "as they will need to be split between Additional Basic and Overtime." & vbNewLine & vbNewLine
            aMsg(5) = "Please refer to the Additional Hours Guidelines tab for more information."

            MsgBox Join(aMsg, Space(1)), vbOKOnly, "Please Check"
         End If
         i = i + 1
      Loop
   End If

End Sub

いくつかのメモ

  • Excel は数値セル値を Double として格納します。セルから数値を読み取る場合、Double 以外を使用する理由はありません。
  • シートのクラス モジュール (イベントがある場所) では、Me キーワードを使用してシートを参照できます。Activesheet を参照していますが、本当に必要なのは、選択の変更が発生したシートです。この場合はたまたま同じですが、他のイベントではそうでない場合があります。
  • <>"" かどうかを確認するよりも、文字列の長さを確認する方が高速です。
  • あなたのFT変数は決して変化せず、まったく変化しません。定数の方が適している場合があります。
  • 配列を使用して長いメッセージのすべての要素を格納し、次に Join を使用して最終的な文字列を作成します。読みやすく、維持しやすい。
  • 私はキーボードの男なので、これは私にとって最も家に近いものですが、選択が変わるたびにメッセージボックスが表示されますか? つまり、矢印キーを使用してエラーを修正するセルに移動しようとすると、一定のメッセージ ボックスが表示されます。残忍。おそらく、_Change イベントまたは _BeforeSave イベントを検討する価値があります。
于 2013-04-04T12:54:48.293 に答える
0

次のコードは少し調整する必要があるかもしれませんが、必要なものに近づくはずです。質問へのコメントにいくつかの提案が実装されています。問題の原因は、文字列変数を使用して数値を処理することでした。

FT、ContractHours、HoursPaid、および SumHours を Single 変数として宣言し、Cancel を Boolean として宣言しました (ただし、サブルーチンでは使用しません)。

VBA エディタのメニュー バーから [ツール] → [オプション] を選択し、[エディタ] タブの [変数の宣言が必要] オプションにチェックマークを付けると、変数の宣言が必要な [明示的なオプション] をコードのデフォルトとして設定できます。 .

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim i As Integer, CheckHours As Boolean, Cancel As Boolean
   Dim MonthX As Worksheet
   Dim FT As Single
   Dim ContractHours As Single
   Dim HoursPaid As Single
   Dim SumHours As Single
   Set MonthX = ThisWorkbook.ActiveSheet
   i = 6
   FT = 37.5
   If Target.Column = 14 Then
      Application.ScreenUpdating = False
      'Use the Employee Number column to perform the check
      Do While MonthX.Cells(i, 3).Value <> ""
         'Assign variables
         ContractHours = MonthX.Cells(i, 5).Value
         HoursPaid = MonthX.Cells(i, 14).Value
         SumHours = MonthX.Cells(i, 18).Value
         'When the contract hours plus the additional hours are greater than 37.50 
         '   display warning
         If SumHours > FT Then
            MsgBox "WARNING: Check the additional hours entered for " & _
               MonthX.Cells(i, 2).Value & " " & MonthX.Cells(i, 1).Value & _
               " as they will need to be split between Additional Basic and Overtime." & _
               vbNewLine & vbNewLine & _
               "Please refer to the Additional Hours Guidelines tab for more information.", vbOKOnly, "Please Check"
            CheckHours = True
         End If
         i = i + 1
      Loop
      'Cancel boolean
      If CheckHours = True Then
        Cancel = True
      End If
      Application.ScreenUpdating = True
   End If
End Sub
于 2013-04-04T04:35:12.463 に答える