ขออนุญาตช่วยปรับVBAในการหาผลรวมในคอลัมน์
Posted: Sat Oct 12, 2024 11:27 pm
ต้องการหาจำนวนเงินและจำนวนสินค้าเป็นชิ้นที่ได้รับเงิน โดยหาผลรวมจำนวนเงินในคอลัมน์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