:D snasui.com ยินดีต้อนรับ :D
ยินดีต้อนรับสู่กระดานถามตอบ Excel and VBA และอื่น ๆ ที่เป็นมิตรกับทุกท่าน มีไฟล์แนบมหาศาล ช่วยให้ท่านค้นหาและติดตามศึกษาได้โดยง่าย :thup: สมาชิกท่านใดที่ยังไม่ได้ระบุ Version ของ Excel ที่ใช้งานจริง สามารถทำตาม Link นี้เพื่อจะได้รับคำตอบที่ตรงกับ Version ของท่านครับ :arrow: ระบุ Version ของ Excel
:!: โปรดทราบ :!:
  1. กรุณาอ่านกฎการใช้บอร์ด (Forum rules) ในตำแหน่งด้านบนของแต่ละบอร์ด
  2. การสมัครสมาชิก การ Login การกู้คืนรหัสผ่าน
    1. สมัครสมาชิกดูขั้นตอนได้ที่ :arrow: สมัครสมาชิก
    2. Login เข้าระบบโดยคลิกปุ่ม Login ตรงมุมขวาบนของหน้านี้ :roll:
    3. การ Login ผ่าน Facebook ดูวิธีที่ :arrow: Login ผ่าน Facebook
    4. ลืมรหัสผ่านสามารถรับรหัสใหม่ได้ที่ :arrow: Reset รหัสผ่าน
  3. มีปัญหาการใช้งาน แจ้งผู้ดูแลระบบได้ที่ :arrow: ติดต่อผู้ดูแลระบบ
  4. กำหนดการตั้งค่าส่วนตัว เช่นตั้งค่าภาษาเป็นไทยหรืออังกฤษดูได้ที่ :arrow: ตั้งค่าส่วนตัว
  5. การตั้งและตอบกระทู้ดูได้ที่ :arrow: วิธีการตั้งและตอบกระทู้
  6. การจัดรูปแบบตัวอักษรด้วย bbcode ในช่องแสดงความคิดเห็นดูได้ที่ :arrow: จัดรูปแบบตัวอักษร
  7. กำหนดขนาดตัวอักษรใน Browser ดูได้ที่ :arrow: กำหนดขนาดตัวอักษรใน Browser

รบกวนช่วยตรวจสูตรครับ

ฟอรัมถาม-ตอบปัญหาการใช้งาน MS Excel and VBA
Forum rules
  1. ไม่อนุญาตให้ใช้ภาษาแชทในการถามและตอบปัญหา ไม่ใช้คำว่า "คับ" หรือ "อ่ะครับ" แทนคำว่า "ครับ" ไม่ใช้คำว่า "เด๋ว" แทนคำว่า "เดี๋ยว" เป็นต้น เนื่องจากเมื่อแปลเป็นภาษาต่างประเทศแล้วจะให้ความหมายผิดไปจากที่ควรจะเป็น
  2. ห้ามถามโดยระบุชื่อผู้ตอบและต้องตั้งชื่อกระทู้ให้สื่อถึงปัญหาที่จะถาม ไม่ตั้งชื่อว่า ช่วยด้วยครับ, มีปัญหามาปรึกษาครับ เป็นต้น
  3. กรุณาอธิบายปัญหาและระบุคำตอบที่ต้องการมาในกระทู้ด้วยเสมอถึงแม้จะอธิบายไว้ในไฟล์แนบแล้วก็ตาม ทั้งนี้เพื่ออำนวยความสะดวกแก่เพื่อนสมาชิกในการค้นหาข้อมูล
  4. กรุณาแนบไฟล์ตัวอย่างพร้อมแสดงคำตอบที่ถูกต้องมาในไฟล์ด้วยเพื่อให้ง่ายต่อการทำความเข้าใจและสะดวกต่อการตอบคำถาม (ขนาดไฟล์ไม่เกิน 500Kb ขนาดภาพไม่เกิน 800*600 Pixel) ไม่แนบเป็น Link มาจากแหล่งอื่นที่อาจจะถูกลบทิ้งไปโดยต้นทางในภายหลัง นอกจากนี้ไม่ควรแนบไฟล์ที่มีข้อมูลสำคัญอันก่อให้เกิดความเสียหายกับตนเองและผู้อื่น
  5. กรณีเป็นคำถามเกี่ยวกับ Programming เช่น VBA, VB.Net, C#, SQL ฯลฯ ต้องลองเขียนมาเองก่อนเสมอ ถามเฉพาะที่ติดปัญหา ระบุ Module, Procedure ที่ติดปัญหาให้ชัดเจน กรุณาโพสต์ Code ให้แสดงเป็น Code คือเปิดด้วย [code] และปิดด้วย [/code] ตัวอย่างเช่น [code]dim r as range[/code] เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)
  6. กรุณาแจ้งผลการใช้งานเมื่อได้รับคำตอบว่าตรงกับความต้องการหรือไม่
User avatar
snasui
Site Admin
Site Admin
Posts: 30744
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: รบกวนช่วยตรวจสูตรครับ

#21

Post by snasui »

:D ตัวอย่างการปรับ 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
yangkodza
Bronze
Bronze
Posts: 372
Joined: Tue Feb 10, 2015 10:37 am
Excel Ver: 2021

Re: รบกวนช่วยตรวจสูตรครับ

#22

Post by yangkodza »

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 แล้ว
มาแต่คะแนนสังคมครับ อีก 2 วิชาไม่ยอมมาด้วย
ลองกด F8 รันทีละสเตปวนไปเรื่อยๆ ก็ไม่ยอมมา
User avatar
snasui
Site Admin
Site Admin
Posts: 30744
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: รบกวนช่วยตรวจสูตรครับ

#23

Post by snasui »

:D ปรับตรงไหน ปรับเป็นอย่างไร แนบไฟล์ที่ปรับเองแล้วพร้อมทั้่งแจ้งมาด้วยว่าถ้าถูกต้องคอลัมน์ใดต้องเป็นค่าเท่าใด จะได้ตอบต่อไปจากนั้นครับ
yangkodza
Bronze
Bronze
Posts: 372
Joined: Tue Feb 10, 2015 10:37 am
Excel Ver: 2021

Re: รบกวนช่วยตรวจสูตรครับ

#24

Post by yangkodza »

ผมเข้าใจแล้วครับ
ต้องทำการเปิดไฟล์ต้นทางทั้ง 3 วิชาก่อน
VBA ถึงจะรันได้

แต่ถ้าเราต้องการให้เป็นระบบไม่ต้องเปิดไฟล์
แต่ใช้วิธีการให้อัปเดทค่ากรณีที่เราเปลี่ยนห้อง
ต้องปรับอย่างไรครับ
User avatar
snasui
Site Admin
Site Admin
Posts: 30744
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: รบกวนช่วยตรวจสูตรครับ

#25

Post by snasui »

:D ลองศึกษาการกำหนดตัวแปรและปรับปรุง Code มาเอง ติดตรงไหนค่อยถามกันต่อครับ
yangkodza
Bronze
Bronze
Posts: 372
Joined: Tue Feb 10, 2015 10:37 am
Excel Ver: 2021

Re: รบกวนช่วยตรวจสูตรครับ

#26

Post by yangkodza »

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


เมื่อเปิดไฟล์ ดึงคะแนน
เราสามารถระบุห้อง ป.1 ได้เลย
เช่น 1-1 หรือ 1-5 เป็นต้น
คะแนนทั้ง 3 วิชา จะถูกดึงขึ้นมาอัตโนมัติ
โดยไม่จำเป็นต้องเปิดไฟล์ต้นทางก่อน

ปัญหาคือ ถ้าไม่พบไฟล์ต้นทาง อยากให้ข้ามไปหาไฟล์ต่อไปครับ
คะแนน.rar
You do not have the required permissions to view the files attached to this post.
User avatar
snasui
Site Admin
Site Admin
Posts: 30744
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: รบกวนช่วยตรวจสูตรครับ

#27

Post by snasui »

:D ตัวอย่าง 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
yangkodza
Bronze
Bronze
Posts: 372
Joined: Tue Feb 10, 2015 10:37 am
Excel Ver: 2021

Re: รบกวนช่วยตรวจสูตรครับ

#28

Post by yangkodza »

snasui wrote::D ตัวอย่าง 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
ขอบคุณมากครับอาจารย์
เป็นไปตามที่ต้องการเลยครับ
ที่เหลือก็ดึงรายวิชาอื่นเข้ามาเพิ่มเติม
น้ำตาจะไหล :rz: :rz:
yangkodza
Bronze
Bronze
Posts: 372
Joined: Tue Feb 10, 2015 10:37 am
Excel Ver: 2021

Re: รบกวนช่วยตรวจสูตรครับ

#29

Post by yangkodza »

เพิ่มเติมครับ
ต้องการดึงคะแนนไฟล์จีน
แต่ข้อมูลในไฟล์เป็นแผ่นงานแต่ละห้อง
เช่น ป.1-1 ป.1-2 เป็นต้น
ไม่สามารถดึงคะแนนเข้ามาได้ครับ
ส่วนไฟล์คะแนนอื่นๆ ดึงได้ตามปกติครับ

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)"
เข้าไปใน VBA แต่ไม่สามารถดึงคะแนนได้
ต้องปรับ Code แบบไหนครับ :flw:
จีน.rar
You do not have the required permissions to view the files attached to this post.
User avatar
snasui
Site Admin
Site Admin
Posts: 30744
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: รบกวนช่วยตรวจสูตรครับ

#30

Post by snasui »

:D ไฟล์ที่แนบมาไม่มีไฟล์ที่ชื่อ "จีนประถม.xlsm" ช่วยแนบมาใหม่อีกรอบจะได้ช่วยทดสอบให้ได้ครับ
yangkodza
Bronze
Bronze
Posts: 372
Joined: Tue Feb 10, 2015 10:37 am
Excel Ver: 2021

Re: รบกวนช่วยตรวจสูตรครับ

#31

Post by yangkodza »

snasui wrote::D ไฟล์ที่แนบมาไม่มีไฟล์ที่ชื่อ "จีนประถม.xlsm" ช่วยแนบมาใหม่อีกรอบจะได้ช่วยทดสอบให้ได้ครับ
ขอโทษด้วยครับ แนบไฟล์งานไม่ครบ :D
จีน.rar
You do not have the required permissions to view the files attached to this post.
User avatar
snasui
Site Admin
Site Admin
Posts: 30744
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: รบกวนช่วยตรวจสูตรครับ

#32

Post by snasui »

:D ตัวอย่าง Code ครับ

Code: Select all

'Other code
Case "จีนประถม.xlsm"
    Range("R4").Resize(50, 1).Formula = "='" & CurrDir & "\[" & fileName & "]ป." & Classroom3 & "'!G4"
'Other code
yangkodza
Bronze
Bronze
Posts: 372
Joined: Tue Feb 10, 2015 10:37 am
Excel Ver: 2021

Re: รบกวนช่วยตรวจสูตรครับ

#33

Post by yangkodza »

snasui wrote::D ตัวอย่าง Code ครับ

Code: Select all

'Other code
Case "จีนประถม.xlsm"
    Range("R4").Resize(50, 1).Formula = "='" & CurrDir & "\[" & fileName & "]ป." & Classroom3 & "'!G4"
'Other code
ขอบคุณมากครับ สมบูรณ์แบบ
แบบนี้สามารถประยุกต์ใช้งานได้ทั้งหมดแล้วครับ :D
yangkodza
Bronze
Bronze
Posts: 372
Joined: Tue Feb 10, 2015 10:37 am
Excel Ver: 2021

Re: รบกวนช่วยตรวจสูตรครับ

#34

Post by yangkodza »

ขอเพิ่มอีกกรณีครับ
ถ้าข้อมูลที่ต้องการดึงอยู่ในช่วงของขอบเขตที่กำหนด
เช่น E7:X7 เราต้องการเช็คก่อนว่าข้อมูลสุดท้ายอยู่ที่เซลใด
จากตัวอย่าง ข้อมูลอยู่ที่ N7 เราก็ดึง ข้อมูลตั้งแต่ N8:N57

คือส่วนนี้เป็นคะแนนของว่ายน้ำ 10 คะแนน แต่อยู่รวมกับวิชาสุขศึกษา
แต่ข้อแม้ของการใส่คะแนนว่ายน้ำคือ ใส่เป็นช่องหลังสุดของทุกระดับชั้นครับ

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"
ต้องปรับสูตรแบบใดครับ

ว่ายน้ำ.rar
You do not have the required permissions to view the files attached to this post.
User avatar
snasui
Site Admin
Site Admin
Posts: 30744
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: รบกวนช่วยตรวจสูตรครับ

#35

Post by snasui »

:D ปกติเราจะสร้างตัวแปรมารับค่าคอลัมน์สุดท้ายเพื่อสะดวกในการนำไปใช้ต่อ ยกตัวอย่างการเช็คบรรทัดที่ 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 =...
ตรง ... คือสูตรที่จะใช้ ลองปรับปรุงมาเองก่อน ติดตรงไหนค่อยถามกันต่อครับ
yangkodza
Bronze
Bronze
Posts: 372
Joined: Tue Feb 10, 2015 10:37 am
Excel Ver: 2021

Re: รบกวนช่วยตรวจสูตรครับ

#36

Post by yangkodza »

snasui wrote::D ปกติเราจะสร้างตัวแปรมารับค่าคอลัมน์สุดท้ายเพื่อสะดวกในการนำไปใช้ต่อ ยกตัวอย่างการเช็คบรรทัดที่ 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
ไปไม่เป็นแล้วครับ ยังติด Error :oops:
ว่ายน้ำ.rar
You do not have the required permissions to view the files attached to this post.
User avatar
snasui
Site Admin
Site Admin
Posts: 30744
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: รบกวนช่วยตรวจสูตรครับ

#37

Post by snasui »

:D ตัวอย่างการปรับ Code และคงจะมีปัญหาในเรื่องการหาคอลัมน์สุดท้ายที่จะใช้งาน

Code: Select all

'Other code
Range(lstCol).Offset(1, 0).Resize(50, 1).Formula = "='" & CurrDir & "\[" & fileName & "]C2T1'!N8"
'Other code
ไฟล์ "ดึงคะแนนตัวเทพ.xlsm" ที่แนบมาต้องการจะหาคอลัมน์สุดท้ายจากบรรท้ดใดและเหตุใดจึงไปหาคอลัมน์สุดท้ายจากบรรท้ัดนั้น อธิบายมาอย่างละเอียดครับ

บรรทัดเริ่มของไฟล์นี้คือบรรทัดที 4 จึงไม่ควรไปหาคอลัมน์สุดท้ายที่มีข้อมูลของบรรทัดที่ 7 นอกจากนี้ Code สำหรับการหาคอลัมน์สุดท้ายที่ผมตอบไปนั้น จะเป็นการไปยังคอลัมน์สุดท้ายของ Worksheet ก่อน แล้วค่อยวิ่งกลับมายังเซลล์แรกที่มีข้อมูลในบรรทัดนั้น หากในบรรรทัดนั้น ๆ มีค่าใด ๆ อยู่ก่อนพื้นที่เป้าหมาย อาจจะได้คำตอบที่ไม่ถูกต้อง จำเป็นต้องปรับให้ตรงกับที่จะใช้งานจริง เช่นปรับเป็น cells(7,"S").end(xltoleft) เป็นต้น

สิ่งที่เป็นปัญหาอีกกรณีคือยังไม่เข้าใจเรื่องการอ้างอิงแบบข้ามไฟล์ สังเกตเครื่องหมายก้ามปูที่ผมใช้ว่าใช้อย่างไร ให้พิจารณาใช้ตามนั้นในทุก ๆ Statement ที่เกี่ยวข้อง เครื่องหมายก้ามปูจะใช้ครอบชื่อไฟล์เสมอ อาจะจะต้องตามไปแก้ไข Code อื่น ๆ เพื่อให้เป็นลักษณะเดียวกัน

ีอีกปัญหาคือเครื่องหมาย Single Quote (') สังเกตว่าผมใช้อย่างไร ให้ใช้ตามนั้นเช่นกัน สิ่งเหล่านี้จะต้องทราบโดยละเอียดหากต้องการจะใช้สูตรการ Link ข้ามไฟล วิธีการสังเกตง่าย ๆ คือให้ดู Link ที่ถูกต้องว่าประกอบด้วยอักขระใด อยู่ตำแหน่งใด ในการเขียน Code ก็จะต้องคำนึงถึงอักขระนั้น ๆ อย่างเคร่งครัดครับ
yangkodza
Bronze
Bronze
Posts: 372
Joined: Tue Feb 10, 2015 10:37 am
Excel Ver: 2021

Re: รบกวนช่วยตรวจสูตรครับ

#38

Post by yangkodza »

ไฟล์ "02สุขศึกษา_ป1.xlsm" ต้องการจะหาคอลัมน์สุดท้ายจากบรรท้ดที่ 8
แต่จริงๆแล้ว ข้อมูลไม่ได้อยู่ท้ายสุด จากไฟล์ดังกล่าว ข้อมูลจะอยู่ที่คอลัมน์ N
สาเหตุที่ต้องการหาคือคะแนนสุดท้ายนี้เป็นคะแนนของว่ายน้ำซึ่งครูผู้สอนจะใส่ไว้ในวิชาสุขศึกษาครับ
และใส่คะแนนเป็นช่องสุดท้าย
จากนั้นต้องการดึงคะแนนจาก คอลัมน์ สุดท้าย ในที่นี้คือ คอลัมน์ N
เอาไปใส่ใน ไฟล์ "ดึงคะแนนตัวเทพ.xlsm" ในช่อง P4 ครับ

ส่วนเรื่องการ Link ข้ามไฟล ผมจะศึกษาตามที่อาจาร์ยแนะนำครับผม
User avatar
snasui
Site Admin
Site Admin
Posts: 30744
Joined: Sun Jan 24, 2010 12:33 pm
Location: Songkhla, Thailand
Excel Ver: 2010, 365
Contact:

Re: รบกวนช่วยตรวจสูตรครับ

#39

Post by snasui »

:D Code ที่ตอบไปไม่ได้หาคอลัมน์สุดท้ายของไฟล์ต้นทางแต่เป็นการหาคอลัมน์สุดท้ายของไฟล์ปลายทาง

หากจะหาคอลัมน์สุดท้ายของไฟล์ต้นทาง จำเป็นต้องเขียนมาเองใหม่ ติดตรงไหนค่อยมาถามกันต่อ งานแบบนี้ควรเปิดไฟล์ต้นทางด้วย Code เพื่อที่จะมาทำงานเสียก่อน ทำงานเสร็จแล้วก็ปิดไปด้วย Code อีกเช่นกัน ไม่เช่นนั้นจะยุ่งยากกับการเขียนสูตรเพื่อหาค่าเซลล์สุดท้ายในไฟล์ต้นทาง ซึ่งจะต้องมีความสามารถเขียนสูตรในระดับประยุกต์ได้เป็นอย่างดีจึงจะทำเช่นนั้นได้ครับ
yangkodza
Bronze
Bronze
Posts: 372
Joined: Tue Feb 10, 2015 10:37 am
Excel Ver: 2021

Re: รบกวนช่วยตรวจสูตรครับ

#40

Post by yangkodza »

snasui wrote::D Code ที่ตอบไปไม่ได้หาคอลัมน์สุดท้ายของไฟล์ต้นทางแต่เป็นการหาคอลัมน์สุดท้ายของไฟล์ปลายทาง

หากจะหาคอลัมน์สุดท้ายของไฟล์ต้นทาง จำเป็นต้องเขียนมาเองใหม่ ติดตรงไหนค่อยมาถามกันต่อ งานแบบนี้ควรเปิดไฟล์ต้นทางด้วย Code เพื่อที่จะมาทำงานเสียก่อน ทำงานเสร็จแล้วก็ปิดไปด้วย Code อีกเช่นกัน ไม่เช่นนั้นจะยุ่งยากกับการเขียนสูตรเพื่อหาค่าเซลล์สุดท้ายในไฟล์ต้นทาง ซึ่งจะต้องมีความสามารถเขียนสูตรในระดับประยุกต์ได้เป็นอย่างดีจึงจะทำเช่นนั้นได้ครับ
ตอนนี้กำลังพยายามหาทางเขียนให้ อยู่ในไฟล "02สุขศึกษา_ป1.xlsm" ก่อนครับ เดี๋ยวเรื่อง Link ค่อยประยุกต์อีกที

รบกวนอาจาร์ยอธิบาย

Code: Select all

cells(8,"S").end(xltoleft)
"S" หมายถึงอะไรครับ
Post Reply