Home>

I want to put the result of the calculation formula according to the date in the first row after column M in the yellow cell range of the Excel sheet below (excel is 2010).

In the beginning, it was displayed by nesting the IF statement of the worksheet function without using VBA, but it became too complicated and the actual range was quite wide and even Excel was difficult to open. , I am trying to display only the result calculated by VBA.

The code written in VBA is as follows.

Sub calc ()
    Dim c, rng
    Set rng = Worksheets (1) .Range ("M2: AJ4")
    For Each c In rng
        Select Case Worksheets (1) .Range ("M1")
            Case Is<Worksheets (1) .Range ("$B2")
                c.Value = 0
            Case Is<= Worksheets (1) .Range ("$C2")
                c.Value = Worksheets (1) .Range ("$G2") * Worksheets (1) .Range ("$A2")
            Case Is<= Worksheets (1) .Range ("$D2")
                c.Value = Worksheets (1) .Range ("$H2") * Worksheets (1) .Range ("$A2")
            Case Is<= Worksheets (1) .Range ("$E2")
                c.Value = Worksheets (1) .Range ("$I2") * Worksheets (1) .Range ("$A2")
            Case Is<= Worksheets (1) .Range ("$F2")
                c.Value = Worksheets (1) .Range ("$J2") * Worksheets (1) .Range ("$A2")
            Case else
                c.vlaue = 0
        End Select
    Next
End Sub


If the anniversary date in the first row after column M is less than the column B date, 0 is calculated. I want to display it, but the relative reference like the worksheet function does not work well, and all become the same value (in this case, all 130).

How can I get the code to change the reference location for each cell?

vba
  • Answer # 1

    COff can be variably adapted when the year increases. Try using it with a copy-pipe.

    Sub calc ()
        With ThisWorkbook.Worksheets (1)
            cOff = 5
            Set Rng = .Range ("M2: Z4")
            For Each R In Rng.Rows
                K = .Cells (R.Row, 1) .Value
                For Each C In R. Cells
                    For i = 2 To cOff + 1
                        If .Cells (C.Row, i) .Value>= .Cells (1, C.Column) .Value Then
                            C.Value = .Cells (C.Row, i + cOff) * K
                            If i = 2 Then C. Value = 0
                            Exit For
                        End If
                    Next i
                Next
            Next
            Set Rng = Nothing
        End With
    End Sub

  • Answer # 2

    The reason is that only one side of the range is determined as the first point.
    It should be written as follows:

    Select Case True
                Case Worksheets (1) .Range ("M1")<Worksheets (1) .Range ("$B2")
                    c.Value = 0
                Case Worksheets (1) .Range ("M1")>= Worksheets (1) .Range ("$B2") And Worksheets (1) .Range ("M1")<Worksheets (1) .Range ("$C2 ")
                    c.Value = Worksheets (1) .Range ("$G2") * Worksheets (1) .Range ("$A2")
            End Select


    After that, I have not shifted the starting point (M1 in the above case).

    If you just make it lighter, isn't it alleviated with the following formula?

    = ((M $1>= $B2) * (M $1<$C2) * $G2 + (M $1>= $C2) * (M $1< ;$D2) * $H2 + (M $1>= $D2) * (M $1<$E2) * $I2 + (M $1>= $E2) * (M $1<$F2) * $J2 + ( M $1>= $F2) * $K2) * $A2


    * Paste the above onto M2 and copy to other cells
    However, since the example format can only be sent to either one, the above is only one side of the starting point.
    * I think VBA is the same.

  • Answer # 3

    If the code is difficult to see, it will be difficult to understand and bugs will not be noticed.

    Also, if an object is set to the correct variable type,
    Enter. And Ctrl + Space will give you suggestions, so
    There will be no typing mistakes.

    An example for reference.

    Sub calc ()
        Dim sht As Worksheet
        Set sht = ThisWorkbook.Worksheets (1)
        With sht
            Dim rng As Range
            Set rng = .Range ("M2: AJ4")
            Dim c As Range
            For Each c In rng
                Select Case .Range ("M1")
                    Case Is<.Range ("$B2"): c.Value = 0
                    Case Is<= .Range ("$C2"): c.Value = .Range ("$G2") * .Range ("$A2")
                    Case Is<= .Range ("$D2"): c.Value = .Range ("$H2") * .Range ("$A2")
                    Case Is<= .Range ("$E2"): c.Value = .Range ("$I2") * .Range ("$A2")
                    Case Is<= .Range ("$F2"): c.Value = .Range ("$J2") * .Range ("$A2")
                    Case Else: c.vlaue = 0
                End Select
            Next
        End With
    End Sub

Related articles