单元格中的Excel计算某些指定单元格

时间:2017-09-26 02:09:50

标签: excel vba excel-vba

我在Excel-2010和Excel-2013上工作。我想做类似下面的事情。

无论我在单元格中输入的数字是什么,该数字必须除以60,并且在按下TAB时应将结果打印在同一单元格上。如果我回到此单元格,则应重新显示输入的数字,而不是计算结果。

我从Kresimir L here得到了很好的回答。但我无法将自己的逻辑应用于我自己的要求。我的Excel工作表如下所示:

I want like this

用户必须在给定日期之前输入他的努力。 (现在请忽略颜色编码)。例如,如果用户输入了 45 ,这意味着对某个日期为45分钟,那么此单元格应转换为 0.75 ,这是小时格式。请注意,除了第12,14,16,18,20行等所有行都不需要进行此计算。

还有一件事,这个工作表是2017年的。我还需要连续几年应用同样的技术。因此,如何使此公式适用于多个工作表?

我对Excel中的编程知之甚少。由于公司的安全政策,我无法打开大部分网站。

任何人都可以帮助我!

1 个答案:

答案 0 :(得分:0)

我能够在多个宝石的帮助下实现这一解决方案。收集了不同人的不同答案,并形成了以下答案。张贴其他人真正需要的人参考。

Option Explicit

Dim DivRg1, DivRg2, DivRg As Range

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Set DivRg1 = Sheet14.Range(Cells(10, 1), Cells(10, 20))
    Set DivRg2 = Sheet14.Range(Cells(12, 1), Cells(12, 20))
    Set DivRg = Application.Union(DivRg1, DivRg2)
    'For Each element In DivRg
        'MsgBox element
    'Next
    If (Target > 2) Then
        Application.EnableEvents = False
        Target = Target / 60
        Target = WorksheetFunction.Floor(Target, 0.01) 'Rounding the result to two decimals
        'Target.Offset(0, 5).Value = 1
        Application.EnableEvents = True
    End If
    Set DivRg = Nothing
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    Set DivRg1 = Sheet14.Range(Cells(10, 1), Cells(10, 20))
    Set DivRg2 = Sheet14.Range(Cells(12, 1), Cells(12, 20))
    Set DivRg = Application.Union(DivRg1, DivRg2)

    Dim iSect As Range
    Set iSect = Application.Intersect(Target, DivRg) 'Here, iSect gives me the value in the cell
    If Not (iSect Is Nothing) And (iSect < 2#) Then
        Application.EnableEvents = False
        iSect = iSect * 60
        If (iSect = 0) Then iSect = Empty
        Application.EnableEvents = True
    End If
    Set DivRg = Nothing
End Sub