ขออนุญาตช่วยปรับVBAในการหาผลรวมในคอลัมน์

[9KiTTi]

ต้องการหาจำนวนเงินและจำนวนสินค้าเป็นชิ้นที่ได้รับเงิน โดยหาผลรวมจำนวนเงินในคอลัมน์Tโดยที่ต้องมีข้อมูลในคอลัมนX เป็น Y และเอามาใส่ในชีทDTTM เช่น ถ้าสินค้าเป็นAA1 ให้เอาจำนวนเงินมาในที่คอลัมน์Bath และใส่จำนวนสินค้าที่ช่องunit โดยที่มีหัวคอลัมน์เป็นAA และให้รวมจำนวนสินค้าที่ได้รับเงินทุกชนิดมาใส่ที่คอลัมน์unitที่หัวคอลัมน์เป็น sum โค้ดที่ผมลองเขียนผลออกมาเป็น 0 และในคอลัมน์unitผลลัพธ์ออกมาไม่ตรง และปัญหาที่ผมคิดไม่ออกคือกรณีที่ คอลัมน์ที่เป็น section มีจำนวนคอลัมน์ที่นำเข้าไม่แน่นอนต้องเขียนอย่างไร ขอความรบกวนช่วยแนะนำด้วยครับ ขอบพระคุณครับ

Code: Select all

Sub sumcol()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim lastRowWithNumber As Long
    Dim lastCol As Long
    Dim i As Long
    Dim sumRange As Range

    Set ws = ThisWorkbook.Sheets("DTTM") ' ชื่อ sheet
    
    ' แถวสุดท้ายที่มีข้อมูลในคอลัมน์ A
    lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row

    ' ลบแถวที่มีข้อความ "รวมทั้งสิ้น" ในคอลัมน์ A ถ้ามีนะ
    For i = lastRow To 1 Step -1
        If ws.Cells(i, "A").Value = "รวมทั้งสิ้น" Then
            ws.Rows(i).Delete
        End If
    Next i

    ' อัปเดตตำแหน่งแถวสุดท้ายที่มีข้อมูลหลังจากลบ
    lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row

    ' หาตำแหน่งแถวสุดท้ายที่มีเลขลำดับในคอลัมน์ A 1 2 3
    lastRowWithNumber = lastRow

    ' ลบแถวถัดจากแถวสุดท้ายที่มีเลขลำดับในคอลัมน์ A จนถึงแถวสุดท้ายที่มีข้อมูล
    If lastRow > lastRowWithNumber Then
        ws.Rows(lastRowWithNumber + 1 & ":" & lastRow).Delete
    End If

    ' อัปเดตตำแหน่งแถวสุดท้ายหลังการลบ
    lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row

    ' รวมคอลัมน์ A:C ที่แถวถัดไป
    ws.Range("A" & lastRow + 3 & ":C" & lastRow + 3).Merge
    ws.Range("A" & lastRow + 3).Value = "รวมทั้งสิ้น"

    ' ตั้งค่าสีพื้นหลัง
    ws.Range("A" & lastRow + 3 & ":D" & lastRow + 3).Interior.Color = RGB(102, 255, 51) ' สี #C6EFCE

    ' จัดตำแหน่งให้ข้อความอยู่ตรงกลาง
    ws.Range("A" & lastRow + 3).HorizontalAlignment = xlCenter
    ws.Range("A" & lastRow + 3).VerticalAlignment = xlCenter
    ws.Range("A" & lastRow + 3).WrapText = True ' เปิดการห่อข้อความ

    ' หาตำแหน่งคอลัมน์สุดท้ายที่มีข้อมูลในแถวที่ 4
    lastCol = ws.Cells(4, ws.Columns.count).End(xlToLeft).Column

    ' คำนวณผลรวมในแต่ละคอลัมน์จากแถวที่ 4 จนถึงแถวสุดท้าย
    For i = 4 To lastCol
        ' ตั้งช่วงที่ต้องคำนวณผลรวม
        Set sumRange = ws.Range(ws.Cells(4, i), ws.Cells(lastRow, i))

        ' ใส่ผลรวมในแถวถัดไป
        ws.Cells(lastRow + 3, i).Value = Application.WorksheetFunction.Sum(sumRange)

        ' ตั้งค่าสีพื้นหลัง
        ws.Cells(lastRow + 3, i).Interior.Color = RGB(102, 255, 51) ' สี #C6EFCE

        ' จัดให้อยู่ตรงกลาง
        ws.Cells(lastRow + 3, i).HorizontalAlignment = xlCenter
        ws.Cells(lastRow + 3, i).VerticalAlignment = xlCenter

        ' เปลี่ยนรูปแบบเป็น #,##0.00
        ws.Cells(lastRow + 3, i).NumberFormat = "#,##0.00"
    Next i

    ' ใส่เส้นขอบทุกด้านให้ทุกเซลล์ในแถวที่มีคำว่า "รวมทั้งสิ้น" จนถึงคอลัมน์สุดท้ายที่มีข้อมูล
    With ws.Range("A" & lastRow + 3 & ":" & ws.Cells(lastRow + 3, lastCol).Address)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
    End With

    ' MsgBox "การรวมและคำนวณเสร็จสมบูรณ์!"
End Sub

[snasui]

ตัวอย่าง Code ครับ

Code: Select all

Sub CountAndSumData()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim lastRowSource As Long
    Dim lastRowDest As Long
    Dim i As Long, j As Long
    Dim countAA As Long, sumAA As Double
    Dim col As Integer, cols As Long, pd As String
    Dim sumUnit As Long, sumAmt As Double
    Dim totalRowSum As Double

    ' กำหนดชีทที่ใช้งาน
    Set wsSource = ThisWorkbook.Sheets("COMBINED_DATA_DTTM")
    Set wsDest = ThisWorkbook.Sheets("DTTM")

    ' หาแถวสุดท้ายของข้อมูลในชีทต้นทาง
    lastRowSource = wsSource.Cells(wsSource.Rows.count, "B").End(xlUp).Row
    ' หาแถวสุดท้ายของข้อมูลในชีทปลายทาง
    lastRowDest = wsDest.Cells(wsDest.Rows.count, "B").End(xlUp).Row
    
    cols = wsDest.Cells(3, wsDest.Columns.count).End(xlToLeft).Column
    
    For col = wsDest.Columns("f").Column To cols - 2 Step 2
        pd = VBA.Trim(VBA.Left(wsDest.Cells(2, col).Value, VBA.Len(wsDest.Cells(2, col).Value) - 1))
        
        ' ลูปผ่านแถวที่มีข้อมูลในชีทปลายทาง ตั้งแต่แถวที่ 4 ลงมา
        For j = 4 To lastRowDest
            
            ' ล้างค่าตัวแปรก่อนเริ่มต้นการคำนวณ
            countAA = 0: sumAA = 0
            totalRowSum = 0
    
            ' ลูปผ่านแถวที่มีข้อมูลในชีทต้นทาง
            For i = 2 To lastRowSource
                If wsSource.Cells(i, "ab").Value = wsDest.Cells(j, 2).Value And wsSource.Cells(i, 24).Value = "Y" Then
                    If wsSource.Cells(i, 13).Value = pd Then
                        countAA = countAA + 1
                        sumAA = sumAA + wsSource.Cells(i, 20).Value
                    End If
                End If
            Next i
    
            ' เขียนค่าลงในชีทปลายทาง
            wsDest.Cells(j, col).Value = countAA ' จำนวน AA ไปที่คอลัมน์ F
            wsDest.Cells(j, col + 1).Value = sumAA   ' ผลรวม AA ไปที่คอลัมน์ G
        Next j
    Next col
    For i = 4 To lastRowDest
        sumUnit = 0: sumAmt = 0
        For col = wsDest.Columns("f").Column To cols - 2 Step 2
            sumUnit = sumUnit + wsDest.Cells(i, col).Value
            sumAmt = sumAmt + wsDest.Cells(i, col + 1).Value
        Next col
        wsDest.Cells(i, cols).Value = sumUnit
        wsDest.Cells(i, cols - 1).Value = sumAmt
    Next i
    MsgBox "ดำเนินการประมวลผลเสร็จสิ้นแล้ว", vbInformation, "ดำเนินการประมวลผล..."
End Sub

[9KiTTi]

ขออนุญาตครับ ผมนำไปปรับไปใช้ในสมุดงานจริง แต่ไม่สามารถทำงานได้ครับ ไม่มีข้อมูลออกมา ขอคำแนะนำด้วยครับ ขอบพระคุณครับ

Code: Select all

Sub CountAndSumData()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim lastRowSource As Long
    Dim lastRowDest As Long
    Dim i As Long, j As Long
    Dim countค่าบริกร As Long, sumค่าบริกร As Double
    Dim col As Integer, cols As Long, pd As String
    Dim sumUnit As Long, sumAmt As Double
    Dim totalRowSum As Double

    ' กำหนดชีทที่ใช้งาน
    Set wsSource = ThisWorkbook.Sheets("COMBINED_DATA_DTTM")
    Set wsDest = ThisWorkbook.Sheets("DTTM")

    ' หาแถวสุดท้ายของข้อมูลในชีทต้นทาง
    lastRowSource = wsSource.Cells(wsSource.Rows.count, "B").End(xlUp).Row
    ' หาแถวสุดท้ายของข้อมูลในชีทปลายทาง
    lastRowDest = wsDest.Cells(wsDest.Rows.count, "B").End(xlUp).Row
    
    cols = wsDest.Cells(3, wsDest.Columns.count).End(xlToLeft).Column
    
    For col = wsDest.Columns("f").Column To cols - 2 Step 2
        pd = VBA.Trim(VBA.Left(wsDest.Cells(2, col).Value, VBA.Len(wsDest.Cells(2, col).Value) - 1))
        
        ' ลูปผ่านแถวที่มีข้อมูลในชีทปลายทาง ตั้งแต่แถวที่ 4 ลงมา
        For j = 4 To lastRowDest
            
            ' ล้างค่าตัวแปรก่อนเริ่มต้นการคำนวณ
            countค่าบริกร = 0: sumค่าบริกร = 0
            totalRowSum = 0
    
            ' ลูปผ่านแถวที่มีข้อมูลในชีทต้นทาง
            For i = 2 To lastRowSource
                If wsSource.Cells(i, "ab").Value = wsDest.Cells(j, 2).Value And wsSource.Cells(i, 24).Value = "Y" Then
                    If wsSource.Cells(i, 13).Value = pd Then
                        countค่าบริกร = countค่าบริกร + 1
                        sumค่าบริกร = sumค่าบริกร + wsSource.Cells(i, 20).Value
                    End If
                End If
            Next i
    
            ' เขียนค่าลงในชีทปลายทาง
            wsDest.Cells(j, col).Value = countค่าบริกร ' จำนวน AA ไปที่คอลัมน์ F
            wsDest.Cells(j, col + 1).Value = sumค่าบริกร   ' ผลรวม AA ไปที่คอลัมน์ G
        Next j
    Next col
    For i = 4 To lastRowDest
        sumUnit = 0: sumAmt = 0
        For col = wsDest.Columns("f").Column To cols - 2 Step 2
            sumUnit = sumUnit + wsDest.Cells(i, col).Value
            sumAmt = sumAmt + wsDest.Cells(i, col + 1).Value
        Next col
        wsDest.Cells(i, cols).Value = sumUnit
        wsDest.Cells(i, cols - 1).Value = sumAmt
    Next i
    MsgBox "ดำเนินการประมวลผลเสร็จสิ้นแล้ว", vbInformation, "ดำเนินการประมวลผล..."
End Sub

[snasui]

ใช้กับไฟล์ตัวอย่างแล้วได้คำตอบไหมครับ

ถ้าได้ให้ตรวจสอบโดยการ Debug ดูว่ากำหนดค่าไฟล์ตัวอย่างกับไฟล์จริงไว้อย่างไรก็จะได้คำตอบได้ไม่ยากครับ

การกำหนดชื่อตัวแปร กำหนดชื่อ Procedure มาสอบถาม กรุณาเขียนเป็นภาษาอังกฤษทั้งหมด ผมใช้ Font สำหรับการเขียน Code เป็นภาษาอังกฤษล้วน มี Font ที่แสดงเป็นภาษาไทยได้แต่ไม่ถนัดใช้งาน การเขียน Code VBA ที่เป็นภาษาไทยปนมาในชื่อ Procedure, ชื่อ Variable ผมจะไม่สะดวกในการทดสอบครับ

[9KiTTi]

ใช้กับไฟล์ตัวอย่างแล้วได้คำตอบไหมครับ

ถ้าได้ให้ตรวจสอบโดยการ Debug ดูว่ากำหนดค่าไฟล์ตัวอย่างกับไฟล์จริงไว้อย่างไรก็จะได้คำตอบได้ไม่ยากครับ

การกำหนดชื่อตัวแปร กำหนดชื่อ Procedure มาสอบถาม กรุณาเขียนเป็นภาษาอังกฤษทั้งหมด ผมใช้ Font สำหรับการเขียน Code เป็นภาษาอังกฤษล้วน มี Font ที่แสดงเป็นภาษาไทยได้แต่ไม่ถนัดใช้งาน การเขียน Code VBA ที่เป็นภาษาไทยปนมาในชื่อ Procedure, ชื่อ Variable ผมจะไม่สะดวกในการทดสอบครับ

ผมปรับเป็นภาษาอังกฤษตามอาจารย์แนะนำ ตอนนี้ใช้งานได้แล้วครับ ขอบพระคุณครับ