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]
เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)ต้องเชียนโค๊ดมาก่อนครับ ติดส่วนไหน จะได้ปรับไปเรื่อยๆbank9597 wrote: หากจะใช้ VBA จำเป็นต้องเขียนโค๊ดมาเองก่อนเสมอครับ
ส่วนปัญหาดังกล่าว สามารถใช้สูตรได้ครับ
ที่เซลล์ I6 คีย์ =SUMIFS($E$5:$E$12,$B$5:$B$12,$H6,$C$5:$C$12,I$5,$D$5:$D$12,LOOKUP(CHAR(255),$I$4:I$4))
คัดลอกไปทางขวามือ แล้วลงล่างพร้อมกัน
Code: Select all
Sub Test0()
Dim rAll As Range, r As Range, rBlanks As Range
Dim i As Integer, rCus As Range, rCod As Range
Application.ScreenUpdating = False
With Sheets("Sheet2")
.Range("A:F").Clear
.Range("E1") = "x"
Sheets("Sheet1").Range("B2").CurrentRegion.Copy .Range("A1")
Set rAll = .Range("A2", .Range("A2").End(xlDown))
For Each r In rAll
r.Offset(0, 4) = r & r.Offset(0, 1) & r.Offset(0, 2)
Next r
Set rAll = rAll.Offset(0, 4)
For Each r In rAll
r.Offset(0, 1) = Application.SumIf(rAll, r, rAll.Offset(0, -1))
Next r
rAll.Offset(0, -1) = rAll.Offset(0, 1).Value
.Range("A1").CurrentRegion.RemoveDuplicates Columns:=5
Set rAll = rAll.Offset(0, -4)
For i = rAll.Count To 1 Step -1
If rAll(i).Row > 2 And rAll(i) <> rAll(i).Offset(-1, 0) Then
rAll(i).EntireRow.Insert
End If
Next i
Set rBlanks = .Range("A2", .Range("A" & Rows.Count).End(xlUp).Offset(1, 0)) _
.SpecialCells(xlBlanks)
For Each r In rBlanks
r = "Code " & r.Offset(-1, 0) & " Total"
r.Offset(0, 3) = Application.SumIf(rAll, r.Offset(-1, 0), rAll.Offset(0, 3))
Next r
For Each r In rAll
If r.Offset(0, 1) <> "" Then r.Offset(0, 4) = r & r.Offset(0, 1)
Next r
Set rAll = rAll.Offset(0, 4)
i = 1
For Each r In rAll
Set rCus = .Range("E2").Resize(i)
Set rCod = .Range("A2").Resize(i)
If Application.CountIf(rCus, r) > 1 Then r.Offset(0, -3) = ""
If Application.CountIf(rCod, r.Offset(0, -4)) > 1 Then r.Offset(0, -4) = ""
i = i + 1
Next r
.Range("E:F").Clear
End With
Application.ScreenUpdating = True
End Sub