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
Sub Save()
'
' Save Macro
'
For i = 2 To Sheets.Count - 1
Sheets(i).Select
Application.Goto Reference:="OFFSET(R3C2,1,,COUNTA(C1)-2,5)"
Selection.Copy
Sheets("ÊÃØ»à·ÍÁ 1").Select
Application.Goto Reference:="R4C2"
If Range("B4") = "" Then Range("B4").Select Else
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next i
End Sub
Code: Select all
Dim rsAll As Range, rs As Range
Dim rtAll As Range, rt As Range
Dim sh As Worksheet
With Worksheets("สรุปเทอม 1")
Set rsAll = .Range("b4", .Range("b" & .Rows.Count).End(xlUp))
For Each rs In rsAll
For Each sh In Worksheets
If sh.Name <> "สรุปเทอม 1" Then
Set rtAll = sh.Range("b4", sh.Range("b" & sh.Rows.Count).End(xlUp))
For Each rt In rtAll
If rt.Value = rs.Value Then
rs.Offset(0, 1).Value = rs.Offset(0, 1).Value + _
rt.Offset(0, 1).Value
rs.Offset(0, 2).Value = rs.Offset(0, 2).Value + _
rt.Offset(0, 2).Value
rs.Offset(0, 3).Value = rs.Offset(0, 3).Value + _
rt.Offset(0, 3).Value
rs.Offset(0, 4).Value = rs.Offset(0, 4).Value + _
rt.Offset(0, 4).Value
End If
Next rt
End If
Next sh
Next rs
End With
ยอดเลยครับสะดวกมากเลย รบกวนอาจารย์ช่วยปรับ Code ให้อีกนิดครับsnasui wrote: ↑Thu Nov 21, 2019 6:39 am ตัวอย่าง Code ครับCode: Select all
Dim rsAll As Range, rs As Range Dim rtAll As Range, rt As Range Dim sh As Worksheet With Worksheets("สรุปเทอม 1") Set rsAll = .Range("b4", .Range("b" & .Rows.Count).End(xlUp)) For Each rs In rsAll For Each sh In Worksheets If sh.Name <> "สรุปเทอม 1" Then Set rtAll = sh.Range("b4", sh.Range("b" & sh.Rows.Count).End(xlUp)) For Each rt In rtAll If rt.Value = rs.Value Then rs.Offset(0, 1).Value = rs.Offset(0, 1).Value + _ rt.Offset(0, 1).Value rs.Offset(0, 2).Value = rs.Offset(0, 2).Value + _ rt.Offset(0, 2).Value rs.Offset(0, 3).Value = rs.Offset(0, 3).Value + _ rt.Offset(0, 3).Value rs.Offset(0, 4).Value = rs.Offset(0, 4).Value + _ rt.Offset(0, 4).Value End If Next rt End If Next sh Next rs End With
If sh.Name <> "สรุปเทอม 1" Then
ได้เลยครับCode: Select all
Sub Macro1()
Dim rsAll As Range, rs As Range
Dim rtAll As Range, rt As Range
Dim sh As Worksheet
Application.ScreenUpdating = False
Range("C4:F18").Select
Selection.ClearContents
Range("C4").Select
With Worksheets("สรุปเทอม 1")
Set rsAll = .Range("b4", .Range("b" & .Rows.Count).End(xlUp))
For Each rs In rsAll
For Each sh In Worksheets
'If sh.Name <> "สรุปเทอม 1" Then 'ถูกต้องต้นฉบับ
'If sh.Name <> "สรุปเทอม 1,ต.ค.2,พ.ย.,ธ.ค.,ม.ค.,ก.พ.,มี.ค.,สรุปเทอม 2,สรุปทั้งปี" Then 'ไม่ผ่าน
'If sh.Name <> Worksheets.Count Then 'ถูกต้องต้นฉบับ 'ไม่ผ่าน
If sh.Name <> Sheets(Array("สรุปเทอม 1", "ต.ค.2", "พ.ย.", "ธ.ค.", "ม.ค.", "ก.พ.", "มี.ค.", _
"สรุปเทอม 2", "สรุปทั้งปี")) Then
Sheets("สรุปเทอม 1").Activate
Set rtAll = sh.Range("b4", sh.Range("b" & sh.Rows.Count).End(xlUp))
For Each rt In rtAll
If rt.Value = rs.Value Then
rs.Offset(0, 1).Value = rs.Offset(0, 1).Value + _
rt.Offset(0, 1).Value
rs.Offset(0, 2).Value = rs.Offset(0, 2).Value + _
rt.Offset(0, 2).Value
rs.Offset(0, 3).Value = rs.Offset(0, 3).Value + _
rt.Offset(0, 3).Value
rs.Offset(0, 4).Value = rs.Offset(0, 4).Value + _
rt.Offset(0, 4).Value
End If
Next rt
End If
Next sh
Next rs
End With
Application.ScreenUpdating = True
End Sub
ตัวอย่างการปรับ Code ครับ
Code: Select all
'Other code
If sh.Index >= 2 and sh.Index <= 7 Then
'Other code
ขอบคุณมากครับ สามารถนำไปประยุกต์กับเทอม2 ได้แล้วครับsnasui wrote: ↑Mon Nov 25, 2019 6:46 pmตัวอย่างการปรับ Code ครับCode: Select all
'Other code If sh.Index >= 2 and sh.Index <= 7 Then 'Other code