วันเสาร์ที่ 17 กรกฎาคม 2021
  0 ตอบกลับ
  เยี่ยมชม 4.1 พันครั้ง
0
โหวต
แก้
สวัสดี
ตรวจสอบรหัสนี้ plz
มาโครย่อย ()

Dim xRg เป็นช่วง
Dim xCell เป็นช่วง
Dim xRRg1 เป็นช่วง
Dim xRRg2 เป็นช่วง

Dim xAAWS เป็นแผ่นงาน
Dim xAWS เป็นเวิร์กชีต
Dim xBWS เป็นแผ่นงาน
Dim xCWS เป็นเวิร์กชีต
Dim xDWS เป็นแผ่นงาน
Dim xEWS เป็นแผ่นงาน
Dim xFWS เป็นเวิร์กชีต
Dim xGWS เป็นเวิร์กชีต
Dim xHWS เป็นแผ่นงาน
Dim xIWS เป็นเวิร์กชีต
Dim xJWS เป็นแผ่นงาน
Dim xKWS เป็นแผ่นงาน
Dim xLWS เป็นแผ่นงาน
Dim xMWS เป็นแผ่นงาน
Dim xNWS เป็นเวิร์กชีต
Dim xPWS เป็นเวิร์กชีต
Dim xQWS เป็นเวิร์กชีต
Dim xRWS เป็นเวิร์กชีต
Dim xSWS เป็นเวิร์กชีต
Dim xTWS เป็นแผ่นงาน
Dim xUWS เป็นแผ่นงาน
Dim xVWS เป็นแผ่นงาน
Dim xWWS เป็นเวิร์กชีต
Dim xXWS เป็นเวิร์กชีต
Dim xYWS เป็นแผ่นงาน
Dim xZWS เป็นแผ่นงาน

xAAR หรี่, xAR, xBR, xCR, xDR, xER, xFR, xGR, xHR, xIR, xJR, xKR, xLR, xMR, xNR, xPR, xQR, xRR, xSR, xTR, xUR, xVR, xR, xWR , xZR ตราบนาน

Dim xDC นานเท่านาน
หรี่ K ตราบ
หรี่ xC1 นาน
Dim xFNum นานเท่านาน

ตั้งค่า xAAWS = แผ่นงาน ("Sheet1") 'Ô?Ê ÇÕá?
Set xAWS = แผ่นงาน ("Sheet2") 'åÒ??å ÈÓÊå ÈäÏ?
ตั้งค่า xBWS = แผ่นงาน ("Sheet3") 'åÒ?äå ÊÈá?ÛÇÊ
ตั้งค่า xCWS = แผ่นงาน ("Sheet4") 'åÒ?äå ÇÏÇÔ
ตั้งค่า xWS = แผ่นงาน("Sheet5") 'åÒ?äå ÛÑÝå ÞÕÇÈ?
ตั้งค่า xEWS = แผ่นงาน ("Sheet6") 'åÒ?äå ÍÞæÞ
ตั้งค่า xFWS = แผ่นงาน ("Sheet7") 'åÒ?äå ÏÑãÇä
ตั้งค่า xGWS = แผ่นงาน ("Sheet8") 'åÒ?äå ÓÝÑæÝæÞ ÇáÚÇÏå ãÇãæÑ?Ê ÏÇÎá ˜ÔæÑ
ชุด xHWS = แผ่นงาน ("Sheet9") 'åÒ?äå Ç?ÇÈ æÐåÇÈ
ตั้งค่า xIWS = แผ่นงาน ("แผ่นที่ 10")
ตั้งค่า xJWS = แผ่นงาน ("Sheet11") 'åÒíäå ÑÓäá æÙ?Ýå
ตั้งค่า xKWS = แผ่นงาน ("Sheet12") 'ÊäÙíÜÜÜÜÜÝ æ ÈÜÜÇÛÈÜÜÜÇäÜÜÜÜÜí
Set xLWS = แผ่นงาน ("Sheet13") 'åÒíäå ÌÔä æ ÐíÑÇí?
ตั้งค่า xMWS = แผ่นงาน("Sheet14") 'åÒíäå ÓÊ ÊáÝä
Set xNWS = แผ่นงาน ("Sheet15") 'åÒíäå äæÔÊ ÇÝÒÇÑ
ตั้งค่า xPWS = แผ่นงาน ("Sheet16") 'åÒíäå ÈÇä˜í
ตั้งค่า xQWS = แผ่นงาน ("Sheet17") 'ÊÚãíÑ æ ä åÏÇÑí ÇËÜÜÜÜÜÜÇËå
ตั้งค่า xRWS = แผ่นงาน ("Sheet18") 'åÒ?äå ÊÚã?Ñ æä åÏÇÑí ÓÇÎÊãÇä
ตั้งค่า xSWS = แผ่นงาน("Sheet19") 'åÒ?äå ÊÚã?Ñ æä åÏÇÑí ÊÇÓ?ÓÇÊ
ชุด xTWS = แผ่นงาน("Sheet20") 'åÒ?äå ÊÚã?Ñ æÓÇÆØ äÞáíå
ชุด xUWS = แผ่นงาน("Sheet21") 'åÒ?äå ÊÌå?ÒÇÊ ÑÇ?Çäå
Set xVWS = แผ่นงาน("Sheet22") 'åÒ?äå ÓæÎÊ æÓÇÆØ äÞá?å
Set xWWS = แผ่นงาน("Sheet23") 'åÒ?äå Íãá æäÞá æÊÎá?å æÈÇÑ ?Ñ?
ตั้งค่า xXWS = แผ่นงาน ("Sheet24") 'ÓÇíÑ åÒíäå åÇ
ตั้งค่า xYWS = แผ่นงาน("Sheet25") 'åÒíäå ÍÞ ÕäÏÞÏÇÑ?
ตั้งค่า xZWS = แผ่นงาน ("Sheet26") 'åÒíäå áÈÇÓ

xAAR = xAAWS.UsedRange.Rows.Count
xAR = xAWS.UsedRange.Rows.Count
xBR = xBWS.UsedRange.Rows.Count
xCR = xCWS.UsedRange.Rows.Count
xDR = xWS.UsedRange.Rows.Count
xER = xEWS.UsedRange.Rows.Count
xFR = xFWS.ใช้ช่วง.แถว.นับ
xGR = xGWS.UsedRange.Rows.Count
xHR = xHWS.UsedRange.Rows.Count
xIR = xIWS.UsedRange.Rows.Count
xJR = xJWS.UsedRange.Rows.Count
xKR = xKWS.UsedRange.Rows.Count
xLR = xLWS.UsedRange.Rows.Count
xMR = xMWS.UsedRange.Rows.Count
xNR = xNWS.UsedRange.Rows.Count
xPR = xPWS.UsedRange.Rows.Count
xQR = xQWS.UsedRange.Rows.Count
xRR = xRWS.ใช้ช่วง.แถว.นับ
xSR = xSWS.UsedRange.Rows.Count
xTR = xTWS.UsedRange.Rows.Count
xUR = xUWS.UsedRange.Rows.Count
xVR = xVWS.ใช้ช่วง.แถว.นับ
xWR = xWWS.UsedRange.Rows.Count
xXR = xXWS.UsedRange.Rows.Count
xYR = xYWS.ใช้ช่วง.แถว.นับ
xZR = xZWS.UsedRange.Rows.Count
xDC = xAAWS.UsedRange.Columns.Count

ถ้า xAR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xAWS.UsedRange) = 0 แล้ว xAR = 0
End If
ถ้า xBR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xBWS.UsedRange) = 0 แล้ว xBR = 0
End If
ถ้า xCR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xCWS.UsedRange) = 0 แล้ว xCR = 0
End If
ถ้า xDR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xWS.UsedRange) = 0 แล้ว xDR = 0
End If
ถ้า xER = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xEWS.UsedRange) = 0 แล้ว xER = 0
End If
ถ้า xFR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xFWS.UsedRange) = 0 แล้ว xFR = 0
End If
ถ้า xGR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xGWS.UsedRange) = 0 แล้ว xGR = 0
End If
ถ้า xHR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xHWS.UsedRange) = 0 แล้ว xHR = 0
End If
ถ้า xIR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xIWS.UsedRange) = 0 แล้ว xIR = 0
End If
ถ้า xJR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xJWS.UsedRange) = 0 แล้ว xJR = 0
End If
ถ้า xKR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xKWS.UsedRange) = 0 แล้ว xKR = 0
End If
ถ้า xLR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xLWS.UsedRange) = 0 แล้ว xLR = 0
End If
ถ้า xMR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xMWS.UsedRange) = 0 แล้ว xMR = 0
End If
ถ้า xNR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xNWS.UsedRange) = 0 แล้ว xNR = 0
End If
ถ้า xPR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xPWS.UsedRange) = 0 แล้ว xPR = 0
End If
ถ้า xQR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xQWS.UsedRange) = 0 แล้ว xQR = 0
End If
ถ้า xRR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xRWS.UsedRange) = 0 แล้ว xRR = 0
End If
ถ้า xSR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xSWS.UsedRange) = 0 แล้ว xSR = 0
End If
ถ้า xTR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xTWS.UsedRange) = 0 แล้ว xTR = 0
End If
ถ้า xUR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xUWS.UsedRange) = 0 แล้ว xUR = 0
End If
ถ้า xVR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xVWS.UsedRange) = 0 แล้ว xVR = 0
End If
ถ้า xWR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xWWS.UsedRange) = 0 แล้ว xWR = 0
End If
ถ้า xXR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xXWS.UsedRange) = 0 แล้ว xXR = 0
End If
ถ้า xYR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xYWS.UsedRange) = 0 แล้ว xYR = 0
End If
ถ้า xZR = 1 แล้ว
ถ้า Application.WorksheetFunction.CountA(xZWS.UsedRange) = 0 แล้ว xZR = 0
End If

ตั้งค่า xRg = xAAWS.Range("C1:C" & xAAR)
เกี่ยวกับข้อผิดพลาดต่อไป
Application.ScreenUpdating = เท็จ
สำหรับ K = 1 ถึง xRg.Count

ถ้า CStr(xRg(K).Value) = "กำลังบรรจุ" แล้ว
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xAWS.Range("A" & xAR + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xAR = xAR + 1

ElseIf CStr(xRg(K).Value) = " โฆษณา" แล้ว
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xBWS.Range("A" & xBR + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xBR = xBR + 1

ElseIf CStr(xRg(K).Value) = "รางวัล" แล้ว
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xCWS.Range("A" & xCR + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xCR = xCR + 1

ElseIf CStr(xRg(K).Value) = " ร้านขายเนื้อ" แล้วก็
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xWS.Range("A" & xDR + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xDR = xDR + 1

ElseIf CStr(xRg(K).Value) = " สิทธิ์" แล้ว
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xEWS.Range("A" & xER + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xER = xER + 1

ElseIf CStr(xRg(K).Value) = " การรักษา" แล้ว
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xFWS.Range("A" & xFR + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xFR = xFR + 1

ElseIf CStr(xRg(K).Value) = " การเดินทางและภารกิจ" จากนั้น
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xGWS.Range("A" & xGR + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xGR = xGR + 1

ElseIf CStr(xRg(K).Value) = " การขนส่ง" จากนั้น
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xHWS.Range("A" & xHR + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xHR = xHR + 1

ElseIf CStr(xRg(K).Value) = " Juice House" จากนั้น
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xIWS.Range("A" & xIR + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xIR = xIR + 1

ElseIf CStr(xRg(K).Value) = " บุคลากรหน้าที่" แล้ว
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xJWS.Range("A" & xJR + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xJR = xJR + 1

ElseIf CStr(xRg(K).Value) = " การทำความสะอาดและทำสวน" จากนั้น
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xKWS.Range("A" & xKR + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xKR = xKR + 1

ElseIf CStr(xRg(K).Value) = " การเฉลิมฉลองและการต้อนรับ" จากนั้น
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xLWS.Range("A" & xLR + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xLR = xLR + 1

ElseIf CStr(xRg(K).Value) = " *****" แล้ว
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xMWS.Range("A" & xMR + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xMR = xMR + 1

ElseIf CStr(xRg(K).Value) = " เครื่องเขียน" แล้วก็
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xNWS.Range("A" & xNR + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xNR = xNR + 1

ElseIf CStr(xRg(K).Value) = " ค่าธรรมเนียมธนาคาร" แล้ว
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xPWS.Range("A" & xPR + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xPR = xPR + 1

ElseIf CStr(xRg(K).Value) = " การซ่อมแซมและบำรุงรักษาเฟอร์นิเจอร์" จากนั้น
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xQWS.Range("A" & xQR + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xQR = xQR + 1

ElseIf CStr(xRg(K).Value) = " การบำรุงรักษาอาคาร" จากนั้น
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xRWS.Range("A" & xRR + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xRR = xRR + 1

ElseIf CStr(xRg(K).Value) = " การบำรุงรักษาสิ่งอำนวยความสะดวก" จากนั้น
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xSWS.Range("A" & xSR + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xSR = xSR + 1

ElseIf CStr(xRg(K).Value) = " การบำรุงรักษารถยนต์" จากนั้น
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xTWS.Range("A" & xTR + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xTR = xTR + 1

ElseIf CStr(xRg(K).Value) = " อุปกรณ์คอมพิวเตอร์ " แล้วก็
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xUWS.Range("A" & xUR + 1).ทั้งแถว
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xUR = xUR + 1

ElseIf CStr(xRg(K).Value) = " เชื้อเพลิงรถยนต์" แล้ว
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xVWS.Range("A" & xVR + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xVR = xVR + 1

ElseIf CStr(xRg(K).Value) = " การขนส่ง การขนถ่าย และการโหลด" จากนั้น
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xWWS.Range("A" & xWR + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xWR = xWR + 1

ElseIf CStr(xRg(K).Value) = " ค่าใช้จ่ายอื่น ๆ " จากนั้น
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xXWS.Range("A" & xXR + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xXR = xXR + 1

ElseIf CStr(xRg(K).Value) = " โต๊ะเงินสด " แล้ว
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xYWS.Range("A" & xYR + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xYR = xYR + 1

ElseIf CStr(xRg(K).Value) = "แต่งตัว" แล้ว
ตั้งค่า xRRg1 = xRg(K).ทั้งแถว
ตั้งค่า xRRg2 = xZVWS.Range("A" & xZR + 1).EntireRow
สำหรับ xFNum = 1 ถึง xDC
xRRg2.Value = xRRg1.มูลค่า
ถัดไป xFNum
xRg(K).ทั้งแถว.ลบ
xZR = xZR + 1

End If
ถัดไป
Application.ScreenUpdating = จริง
ย่อยสิ้นสุด
ไม่มีคำตอบสำหรับโพสต์นี้