Excel VBA数字的正确日期类型?

时间:2013-04-03 14:10:56

标签: excel vba

我有一个记录员工工作时间的模板。第5列显示了他们一周的合同工时,第14列显示了他们工作的额外工作时间。兼职工作人员(每周工作时间少于37.5小时)额外工作时间按标准费率支付。然而,一旦他们一周超过37.50小时,他们将在一个半月内支付(这是在一个单独的专栏中记录)。

下面的代码获取了本周的总小时数(第18列),如果它超过37.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

3 个答案:

答案 0 :(得分: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将数字单元格值存储为双打。如果你正在从一个单元格中读取一个数字,那么除了双重之外,没有理由使用任何东西。
  • 当您在工作表的类模块中(事件所在的位置)时,您可以使用Me关键字来引用工作表。您可以参考Activesheet,但您真正想要的是发生选择更改的工作表。在这种情况下,它们恰好相同,但对于其他事件,它们可能不是。
  • 检查字符串的长度比检查是否&lt;&gt;“”更快。
  • 您的FT变量永远不会改变,使其根本不变。常数可能是更好的选择。
  • 我使用数组来存储长消息的所有元素,然后使用Join来制作最终字符串。更易于阅读和维护。
  • 我是一个键盘人,所以这对我来说最接近我家,但每次选择更改时都会出现一个消息框?这意味着如果我尝试使用箭头键到达我将修复错误的单元格,我将获得不断的消息框。野蛮。也许_Change事件或_BeforeSave事件值得考虑。

答案 1 :(得分:0)

尝试声明为“单个”而不是“字符串”

我们被告知在uni时将十进制数声明为单身。它可以解决您的问题。

或者我注意到的另一件事但不知道它是否会影响它,你的IF语句中没有ELSE

答案 2 :(得分:0)

以下代码可能需要一些调整,但它应该接近你需要的。它在您的问题的评论中实现了几个建议。困难的根源是使用字符串变量来处理数值。

我已将FT,ContractHours,HoursPaid和SumHours声明为单个变量,并将Cancel声明为布尔值(尽管您不在子例程中使用它)。

您可以通过从VBA编辑器的菜单栏中选择工具/选项,然后选中“需要变量声明”选项来设置“Option Explicit” - 这需要声明变量 - 作为代码的默认值编辑器选项卡。

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