snasui.com ยินดีต้อนรับ ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ ระบุ Version ของ Excel
Sub CalculateAndPlaceValues()
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim lastRowSource As Long, lastRowDest As Long
Dim i As Long, j As Long
Dim totalSum As Double
Dim countUnits As Long
Dim unitTotal As Double, bathTotal As Double
Dim currentVal As String
Dim matchedRow As Long
' กำหนดชีทต้นทางและปลายทาง
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
' วนลูปข้อมูลในชีทปลายทาง (DTTM) เริ่มจากแถวที่ 4
For j = 4 To lastRowDest
currentVal = wsDest.Cells(j, "B").Value
' หาและคำนวณผลรวมในชีท COMBINED_DATA_DTTM
totalSum = 0
countUnits = 0
unitTotal = 0
bathTotal = 0
For i = 2 To lastRowSource
' ตัวอักษรจากคอลัมน์ B ที่ 7 ถึง 21
If Mid(wsSource.Cells(i, "B").Value, 7, 15) = currentVal Then
If wsSource.Cells(i, "X").Value = "Y" Then
totalSum = totalSum + wsSource.Cells(i, "T").Value
End If
End If
' คำนวณ unit และ bath ตามเงื่อนไข
If wsSource.Cells(i, "X").Value = "Y" And wsSource.Cells(i, "M").Value = wsDest.Cells(2, j).Value Then
If wsDest.Cells(3, j).Value = "unit" Then
unitTotal = unitTotal + wsSource.Cells(i, "T").Value
ElseIf wsDest.Cells(3, j).Value = "Bath" Then
bathTotal = bathTotal + wsSource.Cells(i, "T").Value
End If
End If
Next i
' วางค่าผลรวมในคอลัมน์ D ของชีทปลายทาง
wsDest.Cells(j, "D").Value = totalSum
' วางค่า unit ในแถวที่ 3
wsDest.Cells(3, j).Value = unitTotal
' วางค่า bath ในแถวที่ 4
wsDest.Cells(4, j).Value = bathTotal
Next j
MsgBox "Calculation and data placement complete!"
End Sub
You do not have the required permissions to view the files attached to this post.
Sub CalculateAndCopyData()
Dim wsCombined As Worksheet
Dim wsDTTM As Worksheet
Dim lastRowCombined As Long
Dim lastRowDTTM As Long
Dim i As Long, j As Long
Dim total As Double
Dim found As Boolean
Dim combinedValue As String
Dim dttmValue As String
Dim dttmCompareValue As String
' กำหนดชีท
Set wsCombined = ThisWorkbook.Sheets("COMBINED_DATA_DTTM")
Set wsDTTM = ThisWorkbook.Sheets("DTTM")
' หาค่าแถวสุดท้ายของ COMBINED_DATA_DTTM
lastRowCombined = wsCombined.Cells(wsCombined.Rows.count, "X").End(xlUp).Row
' หาค่าแถวสุดท้ายของ DTTM โดยเริ่มจาก B4 ลงมา
lastRowDTTM = wsDTTM.Cells(wsDTTM.Rows.count, "B").End(xlUp).Row
' ดึงค่าจากแถวที่ 3 ของชีท DTTM เพื่อนำมาเปรียบเทียบ
dttmCompareValue = Mid(wsDTTM.Range("B3").Value, 7, 15) ' ดึงค่าตัวอักษรที่ 7 ถึง 21
' วนลูปผ่านแถวต่างๆ ในชีท COMBINED_DATA_DTTM
For i = 2 To lastRowCombined
If wsCombined.Range("X" & i).Value = "Y" Then ' ถ้ามีคำว่า "Y" ในคอลัมน์ X
total = wsCombined.Range("T" & i).Value ' ค่าผลรวมในคอลัมน์ T
combinedValue = wsCombined.Range("AB" & i).Value ' ค่าจากคอลัมน์ AB
found = False ' รีเซ็ตตัวแปร found
' ค้นหาข้อมูลที่ตรงกันในคอลัมน์ B ของชีท DTTM เริ่มจากแถว 4
For j = 4 To lastRowDTTM
dttmValue = wsDTTM.Range("B" & j).Value ' ค่าจากคอลัมน์ B ของชีท DTTM
' ตรวจสอบข้อมูลว่า ตรงกับค่าในคอลัมน์ AB และคอลัมน์ D ยังไม่มีข้อมูล
' และตรวจสอบข้อมูลแถวที่ 3 ว่าตรงกับค่าใน COMBINED_DATA_DTTM
If combinedValue = dttmValue And wsDTTM.Range("D" & j).Value = "" And combinedValue = dttmCompareValue Then
' วางผลรวมในคอลัมน์ D ของชีท DTTM
wsDTTM.Range("D" & j).Value = total
found = True
Exit For
End If
Next j
End If
Next i
End Sub
You do not have the required permissions to view the files attached to this post.
Sub ReportDTTM()
Dim wsCombined As Worksheet
Dim wsDTTM As Worksheet
Dim lastRowCombined As Long
Dim lastRowDTTM As Long
Dim i As Long, j As Long
Dim total As Double
Dim combinedValue As String
Dim dttmValue As String
' กำหนดชีท
Set wsCombined = ThisWorkbook.Sheets("COMBINED_DATA_DTTM")
Set wsDTTM = ThisWorkbook.Sheets("DTTM")
' หาค่าแถวสุดท้ายของ COMBINED_DATA_DTTM
lastRowCombined = wsCombined.Cells(wsCombined.Rows.count, "X").End(xlUp).Row
' หาค่าแถวสุดท้ายของ DTTM โดยเริ่มจาก B4 ลงมา
lastRowDTTM = wsDTTM.Cells(wsDTTM.Rows.count, "B").End(xlUp).Row
' ลบข้อมูลในคอลัมน์ D ตั้งแต่ D4 ถึงแถวสุดท้ายที่มีข้อมูล
If lastRowDTTM >= 4 Then
wsDTTM.Range("D4:D" & lastRowDTTM).ClearContents
End If
' วนลูปผ่านแถวต่างๆ ในชีท COMBINED_DATA_DTTM
For i = 2 To lastRowCombined
If wsCombined.Range("X" & i).Value = "Y" Then ' ถ้ามีคำว่า "Y" ในคอลัมน์ X
total = wsCombined.Range("T" & i).Value ' ค่าผลรวมในคอลัมน์ T
combinedValue = wsCombined.Range("AB" & i).Value ' ค่าจากคอลัมน์ AB
' ค้นหาข้อมูลที่ตรงกันในคอลัมน์ B ของชีท DTTM เริ่มจากแถว 4
For j = 4 To lastRowDTTM
dttmValue = wsDTTM.Range("B" & j).Value ' ค่าจากคอลัมน์ B ของชีท DTTM
' ตรวจสอบข้อมูลว่า ตรงกับค่าในคอลัมน์ AB และคอลัมน์ D ยังไม่มีข้อมูล
If combinedValue = dttmValue Then
' ถ้าคอลัมน์ D ยังไม่มีข้อมูล จะวางผลรวมในคอลัมน์ D
If wsDTTM.Range("D" & j).Value = "" Then
wsDTTM.Range("D" & j).Value = total
Else
' ถ้ามีข้อมูลแล้ว จะทำการเพิ่มผลรวม
wsDTTM.Range("D" & j).Value = wsDTTM.Range("D" & j).Value + total
End If
' ตั้งค่าฟอร์แมตให้มีเลขทศนิยม 2 หลักและเครื่องหมายหลักพัน
wsDTTM.Range("D" & j).NumberFormat = "#,##0.00"
End If
Next j
End If
Next i
' ตรวจสอบและใส่เครื่องหมาย "-" ในช่องที่ไม่มีข้อมูลในคอลัมน์ D ตั้งแต่ D4
For j = 4 To lastRowDTTM
If wsDTTM.Range("D" & j).Value = "" Then
wsDTTM.Range("D" & j).Value = "-" ' ใส่เครื่องหมาย "-" ถ้าช่องว่าง
wsDTTM.Range("D" & j).HorizontalAlignment = xlCenter ' จัดให้อยู่กลางเซลล์
End If
Next j
End Sub
You do not have the required permissions to view the files attached to this post.
Sub ReportDTTM()
Dim wsCombined As Worksheet
Dim wsDTTM As Worksheet
Dim lastRowCombined As Long
Dim lastRowDTTM As Long
Dim i As Long, j As Long
Dim total As Double
Dim combinedValue As String
Dim dttmValue As String
' กำหนดชีท
Set wsCombined = ThisWorkbook.Sheets("COMBINED_DATA_DTTM")
Set wsDTTM = ThisWorkbook.Sheets("DTTM")
' หาค่าแถวสุดท้ายของ COMBINED_DATA_DTTM
lastRowCombined = wsCombined.Cells(wsCombined.Rows.count, "X").End(xlUp).Row
' หาค่าแถวสุดท้ายของ DTTM โดยเริ่มจาก B4 ลงมา
lastRowDTTM = wsDTTM.Cells(wsDTTM.Rows.count, "B").End(xlUp).Row
' ลบข้อมูลในคอลัมน์ D ตั้งแต่ D4 ถึงแถวสุดท้ายที่มีข้อมูล
If lastRowDTTM >= 4 Then
wsDTTM.Range("D4:D" & lastRowDTTM).ClearContents
End If
' วนลูปผ่านแถวต่างๆ ในชีท COMBINED_DATA_DTTM
For i = 2 To lastRowCombined
If wsCombined.Range("X" & i).Value = "Y" Then ' ถ้ามีคำว่า "Y" ในคอลัมน์ X
total = wsCombined.Range("T" & i).Value ' ค่าผลรวมในคอลัมน์ T
combinedValue = wsCombined.Range("AB" & i).Value ' ค่าจากคอลัมน์ AB
' ค้นหาข้อมูลที่ตรงกันในคอลัมน์ B ของชีท DTTM เริ่มจากแถว 4
For j = 4 To lastRowDTTM
dttmValue = wsDTTM.Range("B" & j).Value ' ค่าจากคอลัมน์ B ของชีท DTTM
' ตรวจสอบข้อมูลว่า ตรงกับค่าในคอลัมน์ AB และคอลัมน์ D ยังไม่มีข้อมูล
If combinedValue = dttmValue Then
' ถ้าคอลัมน์ D ยังไม่มีข้อมูล จะวางผลรวมในคอลัมน์ D
x = Application.Match("*" & wsCombined.Range("B" & i), wsDTTM.Range("D3:E3"), 0) + 3
If wsDTTM.Cells(j, x).Value = "" Then
wsDTTM.Cells(j, x).Value = total
Else
' ถ้ามีข้อมูลแล้ว จะทำการเพิ่มผลรวม
wsDTTM.Cells(j, x).Value = wsDTTM.Cells(j, x).Value + total
End If
' ตั้งค่าฟอร์แมตให้มีเลขทศนิยม 2 หลักและเครื่องหมายหลักพัน
wsDTTM.Cells(j, x).NumberFormat = "#,##0.00"
End If
Next j
End If
Next i
' ตรวจสอบและใส่เครื่องหมาย "-" ในช่องที่ไม่มีข้อมูลในคอลัมน์ D ตั้งแต่ D4
For j = 4 To lastRowDTTM
If wsDTTM.Range("D" & j).Value = "" Then
wsDTTM.Range("D" & j).Value = "-" ' ใส่เครื่องหมาย "-" ถ้าช่องว่าง
wsDTTM.Range("D" & j).HorizontalAlignment = xlCenter ' จัดให้อยู่กลางเซลล์
End If
Next j
End Sub
Sub ReportDTTM()
Dim wsCombined As Worksheet
Dim wsDTTM As Worksheet
Dim lastRowCombined As Long
Dim lastRowDTTM As Long
Dim i As Long, j As Long
Dim total As Double
Dim combinedValue As String
Dim dttmValue As String
' กำหนดชีท
Set wsCombined = ThisWorkbook.Sheets("COMBINED_DATA_DTTM")
Set wsDTTM = ThisWorkbook.Sheets("DTTM")
' หาค่าแถวสุดท้ายของ COMBINED_DATA_DTTM
lastRowCombined = wsCombined.Cells(wsCombined.Rows.count, "X").End(xlUp).Row
' หาค่าแถวสุดท้ายของ DTTM โดยเริ่มจาก B4 ลงมา
lastRowDTTM = wsDTTM.Cells(wsDTTM.Rows.count, "B").End(xlUp).Row
' ลบข้อมูลในคอลัมน์ D ตั้งแต่ D4 ถึงแถวสุดท้ายที่มีข้อมูล
If lastRowDTTM >= 4 Then
wsDTTM.Range("D4:D" & lastRowDTTM).ClearContents
End If
' วนลูปผ่านแถวต่างๆ ในชีท COMBINED_DATA_DTTM
For i = 2 To lastRowCombined
If wsCombined.Range("X" & i).Value = "Y" Then ' ถ้ามีคำว่า "Y" ในคอลัมน์ X
total = wsCombined.Range("T" & i).Value ' ค่าผลรวมในคอลัมน์ T
combinedValue = wsCombined.Range("AB" & i).Value ' ค่าจากคอลัมน์ AB
' ค้นหาข้อมูลที่ตรงกันในคอลัมน์ B ของชีท DTTM เริ่มจากแถว 4
For j = 4 To lastRowDTTM
dttmValue = wsDTTM.Range("B" & j).Value ' ค่าจากคอลัมน์ B ของชีท DTTM
' ตรวจสอบข้อมูลว่า ตรงกับค่าในคอลัมน์ AB และคอลัมน์ D ยังไม่มีข้อมูล
If combinedValue = dttmValue Then
' ถ้าคอลัมน์ D ยังไม่มีข้อมูล จะวางผลรวมในคอลัมน์ D
x = Application.Match("*" & wsCombined.Range("B" & i), wsDTTM.Range("D3:E3"), 0) + 3
If wsDTTM.Cells(j, x).Value = "" Then
wsDTTM.Cells(j, x).Value = total
Else
' ถ้ามีข้อมูลแล้ว จะทำการเพิ่มผลรวม
wsDTTM.Cells(j, x).Value = wsDTTM.Cells(j, x).Value + total
End If
' ตั้งค่าฟอร์แมตให้มีเลขทศนิยม 2 หลักและเครื่องหมายหลักพัน
wsDTTM.Cells(j, x).NumberFormat = "#,##0.00"
End If
Next j
End If
Next i
' ตรวจสอบและใส่เครื่องหมาย "-" ในช่องที่ไม่มีข้อมูลในคอลัมน์ D ตั้งแต่ D4
For j = 4 To lastRowDTTM
If wsDTTM.Range("D" & j).Value = "" Then
wsDTTM.Range("D" & j).Value = "-" ' ใส่เครื่องหมาย "-" ถ้าช่องว่าง
wsDTTM.Range("D" & j).HorizontalAlignment = xlCenter ' จัดให้อยู่กลางเซลล์
End If
Next j
End Sub
Sub CalculateAndPlaceValues()
Dim wsCombined As Worksheet
Dim wsDTTM As Worksheet
Dim lastRowCombined As Long
Dim lastRowDTTM As Long
Dim i As Long
Dim sumBath As Double
Dim targetRow As Long
Dim targetBathCol As Variant
Dim targetUnitCol As Variant
Dim targetSectionCol As Variant
Dim sumValue As Double
' กำหนดชีทที่ใช้
Set wsCombined = ThisWorkbook.Sheets("COMBINED_DATA_DTTM")
Set wsDTTM = ThisWorkbook.Sheets("DTTM")
' ค้นหาแถวสุดท้ายในชีท COMBINED_DATA_DTTM
lastRowCombined = wsCombined.Cells(wsCombined.Rows.count, "T").End(xlUp).Row
' ค้นหาแถวสุดท้ายในชีท DTTM
lastRowDTTM = wsDTTM.Cells(wsDTTM.Rows.count, "B").End(xlUp).Row
' ค้นหาคอลัมน์ที่มีคำว่า "Bath" ในแถวที่ 3
targetBathCol = Application.Match("Bath", wsDTTM.Rows(3), 0)
' ค้นหาคอลัมน์ที่มีคำว่า "unit" ในแถวที่ 3
targetUnitCol = Application.Match("unit", wsDTTM.Rows(3), 0)
' ค้นหาคอลัมน์ที่มีคำว่า "Section" ในแถวที่ 2
targetSectionCol = Application.Match("Section", wsDTTM.Rows(2), 0)
' ตรวจสอบว่าคอลัมน์ "Bath" พบหรือไม่
If IsError(targetBathCol) Then
MsgBox "ไม่พบคอลัมน์ 'Bath' ในแถวที่ 3", vbCritical
Exit Sub
End If
' ตรวจสอบว่าคอลัมน์ "unit" พบหรือไม่
If IsError(targetUnitCol) Then
MsgBox "ไม่พบคอลัมน์ 'unit' ในแถวที่ 3", vbCritical
Exit Sub
End If
' ตรวจสอบว่าคอลัมน์ "Section" พบหรือไม่
If IsError(targetSectionCol) Then
MsgBox "ไม่พบคอลัมน์ 'Section' ในแถวที่ 2", vbCritical
Exit Sub
End If
' ลูปผ่านแต่ละแถวในชีท COMBINED_DATA_DTTM
For i = 4 To lastRowCombined
If wsCombined.Cells(i, "X").Value = "ชดเชย" Then
' คำนวณผลรวมในคอลัมน์ T
sumBath = sumBath + wsCombined.Cells(i, "T").Value
' ตรวจสอบเงื่อนไขในคอลัมน์ M
If wsCombined.Cells(i, "M").Value = "AA" Then
' วางค่าในแถวที่ 3 และค้นหาแถวในชีท DTTM ที่ตรงกัน
targetRow = Application.Match(wsCombined.Cells(i, "B").Value, wsDTTM.Range("B4:B" & lastRowDTTM), 0) + 3
If Not IsError(targetRow) Then
wsDTTM.Cells(targetRow, targetBathCol).Value = wsCombined.Cells(i, "T").Value
wsDTTM.Cells(targetRow, targetUnitCol).Value = wsCombined.Cells(i, "T").Value
End If
End If
End If
' วางค่าจากคอลัมน์ "Section" ไปที่คอลัมน์ "Bath"
Dim sectionValue As Variant
sectionValue = wsCombined.Cells(i, targetSectionCol).Value
If Not IsEmpty(sectionValue) Then
wsDTTM.Cells(targetRow, targetBathCol).Value = sectionValue
sumValue = sumValue + sectionValue ' คำนวณผลรวม
End If
Next i
' วางผลรวมในแถวที่ 4 ในชีท DTTM
wsDTTM.Cells(4, targetBathCol).Value = sumBath
' วางผลรวมจากคอลัมน์ Section
wsDTTM.Cells(2, targetBathCol).Value = sumValue ' วางที่แถวที่ 2 ของคอลัมน์ "Sum"
End Sub
You do not have the required permissions to view the files attached to this post.
snasui.com ยินดีต้อนรับ 
สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ 
โปรดทราบ 
