EXCEL TOOLS
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
[code]
และปิดด้วย [/code]
ตัวอย่างเช่น [code]dim r as range[/code]
เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)Code: Select all
Option Explicit
Dim k As Integer
Dim r As Integer
Private Sub CommandButton1_Click()
r = 5
For k = 2 To 5
'1010000000 KKK00
If Sheet2.Cells(k, 5) <> "" And Sheet2.Cells(k, 2) = "GOODS" And Sheet2.Cells(k, 4) = "THB" Then
Sheet1.Cells(5, 3) = Sheet2.Cells(k, 5)
End If
If Sheet2.Cells(k, 5) <> "" And Sheet2.Cells(k, 2) = "GOODS" And Sheet2.Cells(k, 4) = "JPY" Then
Sheet1.Cells(6, 3) = Sheet2.Cells(k, 5)
Sheet1.Cells(6, 4) = Sheet2.Cells(k, 4)
Sheet1.Cells(6, 5) = Sheet2.Cells(k, 3)
End If
If Sheet2.Cells(k, 5) <> "" And Sheet2.Cells(k, 2) = "PARTS" And Sheet2.Cells(k, 4) = "JPY" Then
Sheet1.Cells(5, 6) = Sheet2.Cells(k, 5)
Sheet1.Cells(5, 7) = Sheet2.Cells(k, 4)
Sheet1.Cells(5, 8) = Sheet2.Cells(k, 3)
End If
If Sheet2.Cells(k, 5) <> "" And Sheet2.Cells(k, 2) = "PARTS" And Sheet2.Cells(k, 4) = "USD" Then
Sheet1.Cells(6, 6) = Sheet2.Cells(k, 5)
Sheet1.Cells(6, 7) = Sheet2.Cells(k, 4)
Sheet1.Cells(6, 8) = Sheet2.Cells(k, 3)
End If
'1010000001 KKK01
If Sheet3.Cells(k, 5) <> "" And Sheet3.Cells(k, 2) = "OTHERS" Then
Sheet1.Cells(7, 12) = Sheet3.Cells(2, 5) + Sheet13.Cells(8, 4)
End If
'1010000010 KKK10
If Sheet4.Cells(k, 5) <> "" And Sheet4.Cells(k, 2) = "PARTS" And Sheet4.Cells(k, 4) = "JPY" Then
Sheet1.Cells(10, 6) = Sheet4.Cells(k, 5)
Sheet1.Cells(10, 7) = Sheet4.Cells(k, 4)
Sheet1.Cells(10, 8) = Sheet4.Cells(k, 3)
End If
'1010000011 KKK11
If Sheet5.Cells(k, 5) <> "" And Sheet5.Cells(k, 2) = "OTHERS" Then
Sheet1.Cells(12, 12) = Sheet5.Cells(2, 5) + Sheet13.Cells(16, 4)
End If
'1010000020 KKK20
If Sheet6.Cells(k, 5) <> "" And Sheet6.Cells(k, 2) = "GOODS" And Sheet6.Cells(k, 4) = "JPY" Then
Sheet1.Cells(15, 3) = Sheet6.Cells(k, 5)
Sheet1.Cells(15, 4) = Sheet6.Cells(k, 4)
Sheet1.Cells(15, 5) = Sheet6.Cells(k, 3)
'1010000030 KBT
If Sheet7.Cells(k, 5) <> "" And Sheet7.Cells(k, 2) = "PARTS" And Sheet7.Cells(k, 4) = "USD" Then
Sheet1.Cells(18, 6) = Sheet7.Cells(k, 5)
Sheet1.Cells(18, 7) = Sheet7.Cells(k, 4)
Sheet1.Cells(18, 8) = Sheet7.Cells(k, 3)
End If
'1010000031 KKK31
If Sheet8.Cells(k, 5) <> "" And Sheet8.Cells(k, 2) = "OTHERS" Then
Sheet1.Cells(20, 12) = Sheet8.Cells(2, 5) + Sheet13.Cells(28, 4)
End If
'1010000051 KFI51
If Sheet9.Cells(k, 5) <> "" And Sheet9.Cells(k, 2) = "OTHERS" Then
Sheet1.Cells(23, 12) = Sheet9.Cells(2, 5) + Sheet13.Cells(32, 4)
End If
'1012070000 KMTC00
If Sheet10.Cells(k, 5) <> "" And Sheet10.Cells(k, 2) = "GOODS" And Sheet10.Cells(k, 4) = "THB" Then
Sheet1.Cells(26, 3) = Sheet10.Cells(k, 5)
If Sheet10.Cells(k, 5) <> "" And Sheet10.Cells(k, 2) = "PARTS" And Sheet10.Cells(k, 4) = "JPY" Then
Sheet1.Cells(26, 6) = Sheet10.Cells(k, 5)
Sheet1.Cells(26, 7) = Sheet10.Cells(k, 4)
Sheet1.Cells(26, 8) = Sheet10.Cells(k, 3)
End If
'1012070001 KMTC01
If Sheet11.Cells(k, 5) <> "" And Sheet11.Cells(k, 2) = "OTHERS" Then
Sheet1.Cells(28, 12) = Sheet11.Cells(2, 5) + Sheet13.Cells(40, 4)
End If
'1045010001 KSI01
If Sheet12.Cells(k, 5) <> "" And Sheet12.Cells(k, 2) = "OTHERS" Then
Sheet1.Cells(31, 12) = Sheet9.Cells(2, 5) + Sheet13.Cells(44, 4)
End If
r = r + 1
Next
End Sub
Code: Select all
Public Sub TestTest()
Dim rCode As Range, rEachComp As Range, r As Range, r1 As Range, _
dCompCode As Double, sHt As Worksheet, _
aRR() As Variant, iG%, iP%
Set rCode = ActiveSheet.Range("a:a").SpecialCells(xlCellTypeConstants)
For Each sHt In ThisWorkbook.Sheets
'~~> ตรวจชื่อชีท สนใจชีทที่ขึ้นต้นด้วย K
If sHt.Name Like "K*" Then
ReDim aRR(1 To 2, 1 To 10)
With sHt
dCompCode = .Range("a2").Value
Set rEachComp = .Range("f2:f5")
End With
'~~~> สร้าง array
iG = 1: iP = 1
aRR(1, 10) = 0
For Each r In rEachComp
If r.Value = "" Then Exit For
Select Case UCase(r.Offset(, -4).Value)
Case Is = "GOODS"
aRR(iG, 1) = r.Offset(, -1).Value
If r.Value <> r.Offset(, -2).Value Then
aRR(iG, 2) = r.Offset(, -2).Value
aRR(iG, 3) = r.Offset(, -3).Value
End If
iG = iG + 1
Case Is = "PARTS"
aRR(iP, 4) = r.Offset(, -1).Value
If r.Value <> r.Offset(, -2).Value Then
aRR(iP, 5) = r.Offset(, -2).Value
aRR(iP, 6) = r.Offset(, -3).Value
End If
iP = iP + 1
Case Is = "OTHERS"
aRR(1, 10) = aRR(1, 10) + r.Offset(, -1).Value
End Select
'~~~> ตรวจชีทสุดท้าย ข้อมูลบันทึกไม่ทัน
With ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
For Each r1 In .Range("a:a").SpecialCells(xlCellTypeConstants)
If r1.Value = dCompCode Then
aRR(1, 8) = r1.Offset(3, 3).Value
End If
Next r1
End With
Next r
'~~~> ใส่ array ใน Report
For Each r In rCode
If r.Value = dCompCode Then
With r.Offset(, 2).Resize(2, 10)
.ClearContents
.Value = aRR
End With
r.Offset(, 10).Value = r.Offset(, 2).Value + r.Offset(, 5).Value _
+ r.Offset(, 9).Value
r.Offset(1, 10).Value = r.Offset(1, 2).Value + r.Offset(1, 5).Value _
+ r.Offset(1, 9).Value
Exit For
End If
Next r
End If
Next sHt
End Sub
?activesheet.name
แล้ว enter?r.address
ก็จะรู้ว่าตอนนี้ r คือเซลล์อะไร หรือตัวแปร sht คือชีทอะไร ?sht.name
ทำนองนี้ครับvendor
ก็จะรู้ว่าลูกค้ารหัสอะไร จากนั้น*
ก็จะเก็บข้อมูลเข้า array ได้ และสั่งให้หยุดลูปเมื่อเจอ **
aRR() as variant
เป็นตัวแปรแบบอาร์เรย์ครับ ในที่นี้กำหนดให้เป็นประเภท variant คือเก็บข้อมูลได้หลายประเภท ทั้ง ตัวเลข ข้อความ ฯลฯ อาร์เรย์สามารถเก็บข้อมูลได้คล้ายๆ แผ่นงานใน excel (คือมีแถว มีคอลัมน์ และยังมีเชิงลึกอีก) จำค่าเอาไว้ในหน่วยความจำ สามารถเอาค่ามาใช้หรือเอามาวางในแผ่นงานได้เมื่อสั่ง สามารถทำงานได้รวดเร็วกว่าการคัดลอกมาวางในแผ่นงานทีละค่ามากๆ ครับiG
กับ iP
เป็นตัวแปรประเภท integer (ใช้สัญลักษณ์ % แทน as integer
) ใช้เพื่อนับ Goods กับ Parts ของลูกค้าแต่ละรายครับRedim aRR(1 to 2, 1 to 10)
เป็นคำสั่งที่กำหนดขนาดให้กับตัวแปรอาร์เรย์ ในกรณีนี้จะมี 2 แถว และ 10 คอลัมน์ครับCode: Select all
Worksheets("REPORT").Activate
Set rCode = ActiveSheet.Range("a:a").SpecialCells(xlCellTypeConstants)
For k = 1 To lngLastRow
If Sheets("Vendor_All").Cells(k, 2) = "*" Then
ReDim aRR(1 To 2, 1 To 10)
StrVendorCode = Trim(Sheets("Vendor_All").Cells(k, 13))
rCurr = Trim(Sheets("Vendor_All").Cells(k, 11))
rPrd = Trim(Sheets("Vendor_All").Cells(k, 7))
iG = 1: iP = 1
aRR(1, 10) = 0
Select Case rPrd
Case Is = "GOODS"
aRR(iG, 1) = Trim(Sheets("Vendor_All").Cells(k, 10))
If rCurr <> Trim(Sheets("Vendor_All").Cells(k, 9)) Then
aRR(iG, 2) = Trim(Sheets("Vendor_All").Cells(k, 9))
aRR(iG, 3) = Trim(Sheets("Vendor_All").Cells(k, 8))
End If
iG = iG + 1
Case Is = "PARTS"
aRR(iP, 4) = Trim(Sheets("Vendor_All").Cells(k, 10))
If rCurr <> Trim(Sheets("Vendor_All").Cells(k, 9)) Then
aRR(iP, 5) = Trim(Sheets("Vendor_All").Cells(k, 9))
aRR(iP, 6) = Trim(Sheets("Vendor_All").Cells(k, 8))
End If
iP = iP + 1
Case Is = "OTHERS"
aRR(1, 10) = Trim(Sheets("Vendor_All").Cells(k, 10))
End Select
End If
Next k
Worksheets("REPORT").Activate
For r = 1 To 200
If Sheets("REPORT").Cells(r, 1) = StrVendorCode Then
With r.Offset(, 2).Resize(2, 10)
.ClearContents
.Value = aRR
End With
r.Offset(, 10).Value = r.Offset(, 2).Value + r.Offset(, 5).Value _
+ r.Offset(, 9).Value
r.Offset(1, 10).Value = r.Offset(1, 2).Value + r.Offset(1, 5).Value _
+ r.Offset(1, 9).Value
Exit For
End If
Next r
End Sub
*
ก็ให้เอาค่าที่สนใจในแถวเดียวกันเข้าอาร์เรย์ ~~> หยุดลูปที่สองเมื่อเจอ **
Code: Select all
Private Sub CmdVendorcopy_Click()
Dim r As Range, r2 As Range, rCode As Range, rVendor As Range
Dim StrVendorCode As Double
Dim aRR() As Variant, iG%, iP%
Dim k As Long, lngLastRow As Long
lngLastRow = Worksheets("Vendor_All").Cells(Cells.Rows.Count, 2).End(xlUp).Row
With Sheets("report")
.Activate
Set rCode = .Range("a:a").SpecialCells(xlCellTypeConstants, 1)
End With
For Each r In rCode
r.Offset(, 2).Resize(2, 10).ClearContents
Next r
With Sheets("vendor_all")
Set rVendor = .Range("a:a").SpecialCells(xlCellTypeConstants)
'~~> ลูปแรก คอลัมน์ A หาคำว่า vendor
For Each r In rVendor
If InStr(r.Value, "Vendor") > 0 Then
StrVendorCode = r.Offset(, 5).Value
ReDim aRR(1 To 2, 1 To 10)
iG = 1: iP = 1
'~~> ลูปสอง คอลัมน์ B หา '*'
For k = r.Row To lngLastRow
If .Cells(k, "b").Value = "**" Then Exit For
If .Cells(k, "b").Value = "*" Then
Select Case UCase(Trim(.Cells(k, "g").Value))
Case Is = "GOODS"
aRR(iG, 1) = .Cells(k, "j").Value
If .Cells(k, "k") <> .Cells(k, "i") Then
aRR(iG, 2) = .Cells(k, "i").Value
aRR(iG, 3) = .Cells(k, "h").Value
End If
iG = iG + 1
Case Is = "PARTS"
aRR(iP, 4) = .Cells(k, "j").Value
If .Cells(k, "k") <> .Cells(k, "i") Then
aRR(iP, 5) = .Cells(k, "i").Value
aRR(iP, 6) = .Cells(k, "h").Value
End If
iP = iP + 1
Case Is = "OTHERS"
aRR(1, 10) = aRR(1, 10) + .Cells(k, "j").Value
End Select
End If
Next k
aRR(1, 9) = aRR(1, 1) + aRR(1, 4) + aRR(1, 8)
aRR(2, 9) = aRR(2, 1) + aRR(2, 4) + aRR(2, 8)
'~~> ลูปสาม หารหัสเดียวกันในชีท report
For Each r2 In rCode
If r2.Value = StrVendorCode Then
r2.Offset(, 2).Resize(2, 10).Value = aRR
End If
Next r2
End If
Next r
End With
End Sub
Code: Select all
Private Sub CmdVendorcopy_Click()
Dim r As Range, r1 As Range, r2 As Range, r3 As Range, rCode As Range, rVendor As Range
Dim StrVendorCode As Double
Dim aRR() As Variant, iG%, iP%
Dim k, k1 As Long, lngLastRow As Long
lngLastRow = Worksheets("Vendor_All").Cells(Cells.Rows.Count, 2).End(xlUp).Row
With Sheets("report")
.Activate
Set rCode = .Range("a:a").SpecialCells(xlCellTypeConstants, 1)
End With
For Each r In rCode
r.Offset(, 2).Resize(2, 10).ClearContents
Next r
With Sheets("vendor_all")
Set rVendor = .Range("a:a").SpecialCells(xlCellTypeConstants)
'~~> Loop 1 คอลัมน์ A หาคำว่า vendor
For Each r In rVendor
If InStr(r.Value, "Vendor") > 0 Then
StrVendorCode = r.Offset(, 5).Value
ReDim aRR(1 To 2, 1 To 10)
iG = 1: iP = 1
'~~> Loop 2 คอลัมน์ B หา '*'
For k = r.Row To lngLastRow
If .Cells(k, "b").Value = "**" Then Exit For
If .Cells(k, "b").Value = "*" Then
Select Case UCase(Trim(.Cells(k, "g").Value))
Case Is = "GOODS"
aRR(iG, 1) = .Cells(k, "j").Value
If .Cells(k, "k") <> .Cells(k, "i") Then
aRR(iG, 2) = .Cells(k, "i").Value
aRR(iG, 3) = .Cells(k, "h").Value
End If
iG = iG + 1
Case Is = "PARTS"
aRR(iP, 4) = .Cells(k, "j").Value
If .Cells(k, "k") <> .Cells(k, "i") Then
aRR(iP, 5) = .Cells(k, "i").Value
aRR(iP, 6) = .Cells(k, "h").Value
End If
iP = iP + 1
Case Is = "OTHERS"
aRR(1, 10) = aRR(1, 10) + .Cells(k, "j").Value
End Select
'--> Loop 3 ตรวจข้อมูล Sheet รายการบันทึกไม่ทัน
With Sheets("ข้อมูลบันทึกไม่ทัน")
For Each r1 In .Range("a:a").SpecialCells(xlCellTypeConstants)
If r1.Value = StrVendorCode Then
aRR(1, 8) = r1.Offset(3, 3).Value
End If
Next r1
End With
End If
Next k
'--> Loop 4 ตรวจข้อมูล Sheet Accrued
With Sheets("Accrued 240399005")
For Each r3 In .Range("s:s").SpecialCells(xlCellTypeConstants)
If r3.Value = StrVendorCode Then
aRR(1, 10) = aRR(1, 10) + r3.Offset(0, 4).Value
End If
Next r3
End With
'--> Loop 5 ข้อมูล Sheet GR-IR 211101000
With Sheets("GR-IR 211101000")
For k1 = 9 To 28
If .Cells(k1, "ar").Value = "" Then Exit For
If .Cells(k1, "ar").Value = StrVendorCode Then
iG = 1: iP = 1
Select Case UCase(Trim(.Cells(k1, "as").Value))
Case Is = "FG"
aRR(iG, 1) = aRR(iG, 1) + .Cells(k1, "av").Value
If .Cells(k1, "au") <> .Cells(k1, "av") Then
aRR(iG, 2) = .Cells(k1, "at").Value
aRR(iG, 3) = aRR(iG, 3) + .Cells(k1, "au").Value
End If
iG = iG + 1
Case Is = "SP"
aRR(iP, 4) = aRR(iP, 4) + .Cells(k1, "av").Value
If .Cells(k1, "au") <> .Cells(k1, "av") Then
aRR(iP, 5) = .Cells(k1, "at").Value
aRR(iP, 6) = aRR(iP, 6) + .Cells(k1, "au").Value
End If
iP = iP + 1
End Select
End If
Next k1
End With
aRR(1, 9) = aRR(1, 1) + aRR(1, 4) + aRR(1, 8)
aRR(2, 9) = aRR(2, 1) + aRR(2, 4) + aRR(2, 8)
'~~> Loop 6 หารหัสเดียวกันใน Sheet report
For Each r2 In rCode
If r2.Value = StrVendorCode Then
r2.Offset(, 2).Resize(2, 10).Value = aRR
End If
Next r2
End If
Next r
End With
End Sub
KKK (OSAKA)
ในชีท vendor_all มี Goods จำนวน 2 แถว และมีลูกค้ารายนี้ในชีท GR-IR ด้วย (คิดว่า "FG" ในคอลัมน์ AS คือประเภท Goods ใช่ไหมครับ) ซึ่งมี FG 2 รายการเช่นกัน ข้อมูล 2 ชีทนี้จะต้องเอามาอะไรกันครับCode: Select all
Private Sub CmdVendorcopy_Click()
Dim r As Range, r1 As Range, r2 As Range, rTemp As Range, _
rCode As Range, rVendor As Range
Dim dVendorCode As Double
Dim aRR() As Variant, iG%, iP%, k%
With Sheets("report")
.Activate
Set rCode = .Range("a:a").SpecialCells(xlCellTypeConstants, 1)
End With
'~~> 1st Loop for each vendor code in REPORT
For Each r In rCode
dVendorCode = r.Value
With Sheets("vendor_all")
Set rVendor = .Range("a:a").SpecialCells(xlCellTypeConstants)
'~~> 2nd Loop for finding the row this vendor is
For Each r1 In rVendor
If InStr(r1.Value, "Vendor") > 0 Then
ReDim aRR(1 To 2, 1 To 10)
iG = 1: iP = 1
If r1.Offset(, 5).Value = dVendorCode Then
Set rTemp = .Range("b" & r1.Row).Resize(200, 1).SpecialCells(xlCellTypeConstants)
'~~> 3rd Loop for collecting this vendor's data
For Each r2 In rTemp
If r2.Value = "**" Then Exit For
If r2.Value = "*" Then
Select Case Trim(r2.Offset(, 5).Value)
Case Is = "GOODS"
aRR(iG, 1) = r2.Offset(, 8).Value
If r2.Offset(, 7) <> r2.Offset(, 9) Then
aRR(iG, 2) = r2.Offset(, 7).Value
aRR(iG, 3) = r2.Offset(, 6).Value
End If
iG = iG + 1
Case Is = "PARTS"
aRR(iP, 4) = r2.Offset(, 8).Value
If r2.Offset(, 7) <> r2.Offset(, 9) Then
aRR(iP, 5) = r2.Offset(, 7).Value
aRR(iP, 6) = r2.Offset(, 6).Value
End If
iP = iP + 1
Case Is = "OTHERS"
aRR(1, 10) = aRR(1, 10) + r2.Offset(, 8).Value
End Select
End If
Next r2
Exit For
End If
End If
Next r1
End With
'~~> 4th
With Sheets("ข้อมูลบันทึกไม่ทัน")
For Each r1 In .Range("a:a").SpecialCells(xlCellTypeConstants)
If r1.Value = dVendorCode Then
aRR(1, 8) = r1.Offset(3, 3).Value
Exit For
End If
Next r1
End With
'~~> 5th
With Sheets("GR-IR 211101000")
For Each r1 In .Range("ar:ar").SpecialCells(xlCellTypeConstants)
If r1.Value = dVendorCode Then
For k = 1 To 2
Select Case r1.Offset(, 1).Value
Case Is = "FG"
If aRR(k, 2) = r1.Offset(, 2).Value Or _
(IsEmpty(aRR(k, 2)) And r1.Offset(, 2).Value = "THB") Then
aRR(k, 1) = aRR(k, 1) + r1.Offset(, 4).Value
If r1.Offset(, 4) <> r1.Offset(, 3) Then _
aRR(k, 3) = aRR(k, 3) + r1.Offset(, 3).Value
Exit For
End If
Case Is = "SP"
If aRR(k, 2) = r1.Offset(, 2).Value Or _
(IsEmpty(aRR(k, 2)) And r1.Offset(, 2).Value = "THB") Then
aRR(k, 4) = aRR(k, 4) + r1.Offset(, 4).Value
If r1.Offset(, 4) <> r1.Offset(, 3) Then _
aRR(k, 6) = aRR(k, 6) + r1.Offset(, 3).Value
Exit For
End If
End Select
Next k
End If
Next r1
End With
'~~> 6th
With Sheets("Accrued 240399005")
For Each r1 In .Range("s:s").SpecialCells(xlCellTypeConstants)
If r1.Value = dVendorCode Then
aRR(1, 10) = aRR(1, 10) + r1.Offset(, 4).Value
End If
Next r1
End With
r.Offset(, 2).Resize(2, 10).ClearContents
r.Offset(, 2).Resize(2, 10).Value = aRR
Next r
End Sub