ต้องการปรับโค้ดระบุเซลล์แทน

[Xcelvba]

ต้องปรับโค้ดอย่างไรครับ ถ้าจะให้ระบุวันที่แทนที่จะกำหนด วันในโค้ดเลยครับ
ต้องการอ้างอิงดังนี้
เซลล์ C20:D20 สำหรับการคำนวณ C3:CI3
เซลล์ C21:D21 สำหรับการคำนวณ C6:CI6
เซลล์ C22:D22 สำหรับการคำนวณ C9:CI9
เซลล์ C23:D23 สำหรับการคำนวณ C12:CI12

Code: Select all

Sub CalculateSums()
    Dim wsWL As Worksheet
    Dim wsSUM As Worksheet
    Dim lastRow As Long
    Dim dateCell As Range
    Dim dateVal As Integer
    Dim colHeaders As Range
    Dim sumHeaders As Range
    Dim headerMatch As Range
    Dim i As Long, j As Long
    Dim cellValue As Double
    
    Set wsWL = ThisWorkbook.Sheets("W-L")
    Set wsSUM = ThisWorkbook.Sheets("SUM")
    
    
    lastRow = wsWL.Cells(wsWL.Rows.Count, "I").End(xlUp).Row
    
    
    Set colHeaders = wsWL.Range("J1:CP1")
    Set sumHeaders = wsSUM.Range("C1:CI1")
    
    
    wsSUM.Range("C3:CI3").Value = 0
    wsSUM.Range("C6:CI6").Value = 0
    wsSUM.Range("C9:CI9").Value = 0
    wsSUM.Range("C12:CI12").Value = 0

    For i = 2 To lastRow
        
        Set dateCell = wsWL.Cells(i, "I")
        If IsDate(dateCell.Value) Then
            dateVal = Day(dateCell.Value)
            
            
            If dateVal >= 1 And dateVal <= 7 Then
                Set sumRange = wsSUM.Range("C3:CI3")
            ElseIf dateVal >= 8 And dateVal <= 14 Then
                Set sumRange = wsSUM.Range("C6:CI6")
            ElseIf dateVal >= 15 And dateVal <= 21 Then
                Set sumRange = wsSUM.Range("C9:CI9")
            ElseIf dateVal >= 22 And dateVal <= 31 Then
                Set sumRange = wsSUM.Range("C12:CI12")
            Else
                GoTo NextRow
            End If
            
        
            For j = 1 To colHeaders.Columns.Count
                
                Set headerMatch = sumHeaders.Find(what:=colHeaders.Cells(1, j).Value, LookIn:=xlValues, lookat:=xlWhole)
                
                If Not headerMatch Is Nothing Then
                    
                    If IsNumeric(wsWL.Cells(i, j + 9).Value) Then
                        cellValue = wsWL.Cells(i, j + 9).Value
                    Else
                        cellValue = 0
                    End If
                    
                    
                    sumRange.Cells(1, headerMatch.Column - 2).Value = sumRange.Cells(1, headerMatch.Column - 2).Value + cellValue
                End If
            Next j
        End If
        
NextRow:
    Next i
    
    MsgBox "Calculation complete!"
End Sub

[puriwutpokin]

ปรับเป็นแบบนี้ได้หรือเปล่าครับ

Code: Select all

'Other code...
            If dateVal >= Sheet1.[c20] And dateVal <= Sheet1.[d20] Then
                Set sumRange = wsSUM.Range("C3:CI3")
            ElseIf dateVal >= Sheet1.[c21] And dateVal <= Sheet1.[d21] Then
                Set sumRange = wsSUM.Range("C6:CI6")
            ElseIf dateVal >= Sheet1.[c22] And dateVal <= Sheet1.[d22] Then
                Set sumRange = wsSUM.Range("C9:CI9")
            ElseIf dateVal >= Sheet1.[c23] And dateVal <= Sheet1.[d23] Then
                Set sumRange = wsSUM.Range("C12:CI12")
            Else
                GoTo NextRow
            End If
'Other code...            

[Xcelvba]

เพิ่ม .Value ได้ตามต้องการครับ ขอบคุณครับ

ปรับเป็นแบบนี้ได้หรือเปล่าครับ

Code: Select all

'Other code...
            If dateVal >= Sheet1.[c20] And dateVal <= Sheet1.[d20] Then
                Set sumRange = wsSUM.Range("C3:CI3")
            ElseIf dateVal >= Sheet1.[c21] And dateVal <= Sheet1.[d21] Then
                Set sumRange = wsSUM.Range("C6:CI6")
            ElseIf dateVal >= Sheet1.[c22] And dateVal <= Sheet1.[d22] Then
                Set sumRange = wsSUM.Range("C9:CI9")
            ElseIf dateVal >= Sheet1.[c23] And dateVal <= Sheet1.[d23] Then
                Set sumRange = wsSUM.Range("C12:CI12")
            Else
                GoTo NextRow
            End If
'Other code...