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
Dim wb As Workbook, foundBook As Boolean
Dim Classroom As Integer, col As String
CurrDir = Application.ActiveWorkbook.Path
Classroom = [z4].Value
For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name Then
foundBook = False
Select Case wb.Name
Case "01สังคม_ป1.xlsm"
foundBook = True
col = "J"
Case "02สุขศึกษา_ป1.xlsm"
foundBook = True
col = "L"
Case "03ศิลปะ_ป1.xlsm"
foundBook = True
col = "M"
End Select
If foundBook Then
If Classroom = "1" Then
Range(col & 4).Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง1เทอม1"
ElseIf Classroom = "2" Then
Range(col & 4).Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง2เทอม1"
ElseIf Classroom = "3" Then
Range(col & 4).Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง3เทอม1"
ElseIf Classroom = "4" Then
Range(col & 4).Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง4เทอม1"
ElseIf Classroom = "5" Then
Range(col & 4).Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง5เทอม1"
End If
Range(col & 4 & ":" & col & 53).FillDown
End If
End If
Next wb
Code: Select all
Sub ดึงok()
Dim wb As Workbook, foundBook As Boolean
Dim Classroom As Integer, col As String
CurrDir = Application.ActiveWorkbook.Path
Classroom = [z4].Value
For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name Then
foundBook = False
Select Case wb.Name
Case "01สังคม_ป1.xlsm"
foundBook = True
col = "J"
Case "02สุขศึกษา_ป1.xlsm"
foundBook = True
col = "L"
Case "03ศิลปะ_ป1.xlsm"
foundBook = True
col = "M"
End Select
If foundBook Then
If Classroom = "1" Then
Range(col & 4).Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง1เทอม1"
ElseIf Classroom = "2" Then
Range(col & 4).Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง2เทอม1"
ElseIf Classroom = "3" Then
Range(col & 4).Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง3เทอม1"
ElseIf Classroom = "4" Then
Range(col & 4).Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง4เทอม1"
ElseIf Classroom = "5" Then
Range(col & 4).Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง5เทอม1"
End If
Range(col & 4 & ":" & col & 53).FillDown
End If
End If
Next wb
End Sub
Code: Select all
Sub เปลี่ยนห้อง()
CurrDir = Application.ActiveWorkbook.Path
Classroom = InputBox("ระบุห้องที่สอน เช่น 6-1")
Range("B3").Select
ActiveCell.Formula = "='" & CurrDir & "\[รายชื่อประถม.xlsx]ป." & Classroom & "'!B3"
Selection.AutoFill Destination:=Range("b3:E3"), Type:=xlFillDefault
Range("b3:E3").Select
Selection.AutoFill Destination:=Range("b3:E52")
Range("b3").Select
Call Module4.คะแนน
End Sub
Code: Select all
Sub คะแนน()
CurrDir = Application.ActiveWorkbook.Path
Sheets("รวม 12 วิชาเทอม1").Select
Classroom = [z4].Value
Range("J4").Select
ActiveCell.FormulaR1C1 = "='01สังคม_ป1.xlsm'!ห้อง" & Classroom & "เทอม1"
ActiveCell.Formula = "='" & CurrDir & "\01สังคม_ป1.xlsm'!ห้อง" & Classroom & "เทอม1"
Selection.AutoFill Destination:=Range("สังคม")
Range("สังคม").FillDown
Range("L4").Select
ActiveCell.Formula = "='" & CurrDir & "\02สุขศึกษา_ป1.xlsm'!ห้อง" & Classroom & "เทอม1"
Selection.AutoFill Destination:=Range("สุขศึกษา")
Range("สุขศึกษา").FillDown
Range("M4").Select
ActiveCell.Formula = "='" & CurrDir & "\03ศิลปะ_ป1.xlsm'!ห้อง" & Classroom & "เทอม1"
Selection.AutoFill Destination:=Range("ศิลปะ")
Range("ศิลปะ").FillDown
End Sub
Code: Select all
Dim FilePath As String, fileName As String
Dim Classroom As String, CurrDir As String
CurrDir = Application.ActiveWorkbook.Path
Sheets("รวม 12 วิชาเทอม1").Select
Classroom = [z4].Value
fileName = Dir(CurrDir & "\*.xls")
Do Until fileName = ""
Select Case fileName
Case "01สังคม_ป1.xlsm"
Range("J4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!ห้อง" & Classroom & "เทอม1"
Case "02สุขศึกษา_ป1.xlsm"
Range("L4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!ห้อง" & Classroom & "เทอม1"
Case "03ศิลปะ_ป1.xlsm"
Range("M4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!ห้อง" & Classroom & "เทอม1"
End Select
fileName = Dir()
Loop
ขอบคุณมากครับอาจารย์snasui wrote: ตัวอย่าง Code ครับ
Code: Select all
Dim FilePath As String, fileName As String Dim Classroom As String, CurrDir As String CurrDir = Application.ActiveWorkbook.Path Sheets("รวม 12 วิชาเทอม1").Select Classroom = [z4].Value fileName = Dir(CurrDir & "\*.xls") Do Until fileName = "" Select Case fileName Case "01สังคม_ป1.xlsm" Range("J4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!ห้อง" & Classroom & "เทอม1" Case "02สุขศึกษา_ป1.xlsm" Range("L4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!ห้อง" & Classroom & "เทอม1" Case "03ศิลปะ_ป1.xlsm" Range("M4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!ห้อง" & Classroom & "เทอม1" End Select fileName = Dir() Loop
Code: Select all
Sub เปลี่ยนห้อง()
CurrDir = Application.ActiveWorkbook.Path
Classroom = InputBox("ระบุห้องที่สอน เช่น 6-1")
Range("B3").Select
ActiveCell.Formula = "='" & CurrDir & "\[รายชื่อประถม.xlsx]ป." & Classroom & "'!B3"
Selection.AutoFill Destination:=Range("b3:E3"), Type:=xlFillDefault
Range("b3:E3").Select
Selection.AutoFill Destination:=Range("รายชื่อ")
Range("b3").Select
Call Module1.คะแนนเทอม1
Sheets("หน้าแรก").Select
End Sub
Sub คะแนนเทอม1()
Dim FilePath As String, fileName As String
Dim Classroom As String, CurrDir As String
CurrDir = Application.ActiveWorkbook.Path
Sheets("รวม 12 วิชาเทอม1").Select
'*******ตั้งต่า
Range("AG4").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-27],1,1)" 'ระดับชั้น
Range("AG5").Select
ActiveCell.FormulaR1C1 = "=MID(R[-1]C[-27],3,1)" 'ห้อง
Range("AG6").Select
'*******
Range("G4:R53").Select
Selection.ClearContents 'ลบคะแนนทิ้งก่อน
Classroom1 = [AG4].Value 'ระดับชั้น
Classroom = [AG5].Value 'ห้อง
Classroom3 = [AG6].Value ' จีน
fileName = Dir(CurrDir & "\*.xlsm")
Do Until fileName = ""
Select Case fileName
Case "01สังคม_ป" & Classroom1 & ".xlsm"
Range("J4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!ห้อง" & Classroom & "เทอม1"
Case "02สุขศึกษา_ป" & Classroom1 & ".xlsm"
Range("L4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!ห้อง" & Classroom & "เทอม1"
Case "03ศิลปะ_ป" & Classroom1 & ".xlsm"
Range("M4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!ห้อง" & Classroom & "เทอม1"
Case "04กอท_ป" & Classroom1 & ".xlsm"
Range("N4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!ห้อง" & Classroom & "เทอม1"
Case "05English_P" & Classroom1 & ".xlsm"
Range("O4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!ห้อง" & Classroom & "เทอม1"
Case "06คอมพิวเตอร์_ป" & Classroom1 & ".xlsm"
Range("P4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!ห้อง" & Classroom & "เทอม1"
Case "07English Conversation_p" & Classroom1 & ".xlsm"
Range("Q4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!ห้อง" & Classroom & "เทอม1"
Case "จีนประถม.xlsm"
Range("R4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!ป." & Classroom3 & "'!G4:G53)"
End Select
fileName = Dir()
Loop
Range("R4").Select
End Sub
Code: Select all
Case "จีนประถม.xlsm"
Range("R4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!ป." & Classroom3 & "'!G4:G53)"
ขอโทษด้วยครับ แนบไฟล์งานไม่ครบsnasui wrote: ไฟล์ที่แนบมาไม่มีไฟล์ที่ชื่อ "จีนประถม.xlsm" ช่วยแนบมาใหม่อีกรอบจะได้ช่วยทดสอบให้ได้ครับ
Code: Select all
'Other code
Case "จีนประถม.xlsm"
Range("R4").Resize(50, 1).Formula = "='" & CurrDir & "\[" & fileName & "]ป." & Classroom3 & "'!G4"
'Other code
ขอบคุณมากครับ สมบูรณ์แบบsnasui wrote: ตัวอย่าง Code ครับ
Code: Select all
'Other code Case "จีนประถม.xlsm" Range("R4").Resize(50, 1).Formula = "='" & CurrDir & "\[" & fileName & "]ป." & Classroom3 & "'!G4" 'Other code
Code: Select all
Sub คะแนนเทอม1()
Dim FilePath As String, fileName As String
Dim Classroom As String, CurrDir As String
CurrDir = Application.ActiveWorkbook.Path
Sheets("รวม 12 วิชาเทอม1").Select
'*******ตั้งต่า
Range("AG4").Select
ActiveCell.FormulaR1C1 = "=MID(RC[-27],1,1)" 'ระดับชั้น
Range("AG5").Select
ActiveCell.FormulaR1C1 = "=MID(R[-1]C[-27],3,1)" 'ห้อง
Range("AG6").Select
'*******
Range("G4:R53").Select
Selection.ClearContents 'ลบคะแนนทิ้งก่อน
Classroom1 = [AG4].Value 'ระดับชั้น
Classroom = [AG5].Value 'ห้อง
Classroom3 = [AG6].Value ' จีน
fileName = Dir(CurrDir & "\*.xlsm")
Do Until fileName = ""
Select Case fileName
Case "01สังคม_ป" & Classroom1 & ".xlsm"
Range("J4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!ห้อง" & Classroom & "เทอม1"
Case "02สุขศึกษา_ป" & Classroom1 & ".xlsm"
Range("L4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!ห้อง" & Classroom & "เทอม1"
Case "03ศิลปะ_ป" & Classroom1 & ".xlsm"
Range("M4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!ห้อง" & Classroom & "เทอม1"
Case "04กอท_ป" & Classroom1 & ".xlsm"
Range("N4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!ห้อง" & Classroom & "เทอม1"
Case "05English_P" & Classroom1 & ".xlsm"
Range("O4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!ห้อง" & Classroom & "เทอม1"
Case "06คอมพิวเตอร์_ป" & Classroom1 & ".xlsm"
Range("P4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!ห้อง" & Classroom & "เทอม1"
Case "07English Conversation_p" & Classroom1 & ".xlsm"
Range("Q4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!ห้อง" & Classroom & "เทอม1"
Case "จีนประถม.xlsm"
Range("R4").Resize(50, 1).Formula = "='" & CurrDir & "\[" & fileName & "]ป." & Classroom3 & "'!G4"
Case "CNNประถม.xlsm"
Range("Q4").Resize(50, 1).Formula = "='" & CurrDir & "\[" & fileName & "]ป." & Classroom3 & "'!C2"
Case "02สุขศึกษา_ป" & Classroom1 & ".xlsm"
Range("P4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!C" & Classroom & "T1'!N8"
End Select
fileName = Dir()
Loop
Range("P4").Select
End Sub
Code: Select all
Case "02สุขศึกษา_ป" & Classroom1 & ".xlsm"
Range("P4").Resize(50, 1).Formula = "='" & CurrDir & "\" & fileName & "'!C" & Classroom & "T1'!N8"
Code: Select all
dim lstCol as string
lstCol = cells(7,columns.count).end(xltoleft).address(0,0)
range(lstCol).offset(1,0).resize(50,1).formula =...
snasui wrote: ปกติเราจะสร้างตัวแปรมารับค่าคอลัมน์สุดท้ายเพื่อสะดวกในการนำไปใช้ต่อ ยกตัวอย่างการเช็คบรรทัดที่ 7 ว่าข้อมูลสุดท้ายอยู่ที่เซลล์ใด สามารถเขียนเป็นด้านล่างครับ
ตรง ... คือสูตรที่จะใช้ ลองปรับปรุงมาเองก่อน ติดตรงไหนค่อยถามกันต่อครับCode: Select all
dim lstCol as string lstCol = cells(7,columns.count).end(xltoleft).address(0,0) range(lstCol).offset(1,0).resize(50,1).formula =...
Code: Select all
Sub ว่ายน้ำ()
Dim lstCol As String
CurrDir = Application.ActiveWorkbook.Path
Classroom1 = [AG4].Value 'ระดับชั้น
Classroom = [AG5].Value 'ห้อง
Classroom3 = [AG6].Value ' จีน
fileName = Dir(CurrDir & "\*.xlsm")
Do Until fileName = ""
Select Case fileName
Case "02สุขศึกษา_ป" & Classroom1 & ".xlsm"
lstCol = Cells(7, Columns.Count).End(xlToLeft).Address(0, 0)
Range(lstCol).Offset(1, 0).Resize(50, 1).Formula = "='" & CurrDir & "\[" & fileName & "]!c1t1'!P4"
End Select
fileName = Dir()
Loop
Range("P4").Select
End Sub
Code: Select all
'Other code
Range(lstCol).Offset(1, 0).Resize(50, 1).Formula = "='" & CurrDir & "\[" & fileName & "]C2T1'!N8"
'Other code
cells(7,"S").end(xltoleft)
เป็นต้น'
) สังเกตว่าผมใช้อย่างไร ให้ใช้ตามนั้นเช่นกัน สิ่งเหล่านี้จะต้องทราบโดยละเอียดหากต้องการจะใช้สูตรการ Link ข้ามไฟล วิธีการสังเกตง่าย ๆ คือให้ดู Link ที่ถูกต้องว่าประกอบด้วยอักขระใด อยู่ตำแหน่งใด ในการเขียน Code ก็จะต้องคำนึงถึงอักขระนั้น ๆ อย่างเคร่งครัดครับตอนนี้กำลังพยายามหาทางเขียนให้ อยู่ในไฟล "02สุขศึกษา_ป1.xlsm" ก่อนครับ เดี๋ยวเรื่อง Link ค่อยประยุกต์อีกทีsnasui wrote: Code ที่ตอบไปไม่ได้หาคอลัมน์สุดท้ายของไฟล์ต้นทางแต่เป็นการหาคอลัมน์สุดท้ายของไฟล์ปลายทาง
หากจะหาคอลัมน์สุดท้ายของไฟล์ต้นทาง จำเป็นต้องเขียนมาเองใหม่ ติดตรงไหนค่อยมาถามกันต่อ งานแบบนี้ควรเปิดไฟล์ต้นทางด้วย Code เพื่อที่จะมาทำงานเสียก่อน ทำงานเสร็จแล้วก็ปิดไปด้วย Code อีกเช่นกัน ไม่เช่นนั้นจะยุ่งยากกับการเขียนสูตรเพื่อหาค่าเซลล์สุดท้ายในไฟล์ต้นทาง ซึ่งจะต้องมีความสามารถเขียนสูตรในระดับประยุกต์ได้เป็นอย่างดีจึงจะทำเช่นนั้นได้ครับ
Code: Select all
cells(8,"S").end(xltoleft)