Page 1 of 3
รบกวนช่วยตรวจสูตรครับ
Posted: Sun Aug 27, 2017 7:59 pm
by yangkodza
Code: Select all
Sub คะแนน()
Sheets("รวม 12 วิชา").Select
' ส15101 สังคม
Range("j2").Select
ActiveCell.FormulaR1C1 = "=[ส15101.xls]ห้อง" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), 1) & "!R[6]C[32]"
Selection.AutoFill Destination:=Range("j2:j51")
End Sub
จาก Code ดังกล่าว การทำงานถูกต้อง
ชื่อแผ่นงานในไฟล์ ส15101.xls จะเป็น ห้อง1 ห้อง2 ห้อง3 ตามลำดับ
ถ้าแปลี่ยนชื่อแผ่นงานเป็น C1 C2 C3 ผมเปลี่ยน คำว่า "ห้อง" เป็น "C" ยังคงทำงานตามปกติได้อยู่
แต่ผมต้องปรับเป็น c1t1 c2t1 c3t1 ตามลำดับ
ผมต้องการเปลี่ยนชื่อแผ่นงาน ทำให้การอ้างอิงผิดไป
ผมต้องปรับสูตรแบบไหนครับ
Re: รบกวนช่วยตรวจสูตรครับ
Posted: Sun Aug 27, 2017 8:12 pm
by snasui
แนบไฟล์ตัวอย่างที่มีชื่อชีตตามที่ต้องการจะใช้จริงมาด้วยจะได้สะดวกในการตอบครับ
Re: รบกวนช่วยตรวจสูตรครับ
Posted: Sun Aug 27, 2017 8:36 pm
by yangkodza
ไฟล์แนบครับ
01 ครูประจำชั้น.xls
รายชื่อประถม.xlsx
ส15101.xls
ไฟล์ Run คือ ครูประจำชั้น ลองกดเปลี่ยนห้องเป็น 5-1 หรือ 5-2 ดูครับ จะปกติ
เพราะว่าชื่อแผ่นงานใน ส15101 เป็น C1 C2
แต่ผมต้องการเปลี่ยนชื่อแผ่นงาน จาก C1 เป็น C1T1 และ C2 เป็น C2T1
ทำให้ไม่สามารถอ้างอิงคะแนนได้ครับ
มาโครอยู่ในไฟล์ ครูประจำชั้น ชื่อมาโครมา คะแนน
Re: รบกวนช่วยตรวจสูตรครับ
Posted: Sun Aug 27, 2017 9:36 pm
by snasui
สุตรในไฟล์ ครูประจำชั้น ติดการอ้างอิงแบบ Error ที่น่าจะเกิดการลบชีตทิ้งไป กรุณาแนบมาใหม่ครับ
Re: รบกวนช่วยตรวจสูตรครับ
Posted: Sun Aug 27, 2017 9:55 pm
by yangkodza
snasui wrote: สุตรในไฟล์ ครูประจำชั้น ติดการอ้างอิงแบบ Error ที่น่าจะเกิดการลบชีตทิ้งไป กรุณาแนบมาใหม่ครับ
01 ครูประจำชั้น.xls
รบกวนด้วยครับ
Re: รบกวนช่วยตรวจสูตรครับ
Posted: Mon Aug 28, 2017 7:14 pm
by snasui
เปลี่ยนบรรทัดนี้ครับ
ActiveCell.FormulaR1C1 = "='" & CurrDir & "\[รายชื่อประถม.xlsx]ป." & ClassRoom & "'!R3c2:r52C5"
เปลี่ยนเป็น
ActiveCell.FormulaR1C1 = "='" & CurrDir & "\[รายชื่อประถม.xlsx]" & ClassRoom & "'!R3c2:r52C5"
โดยไฟล์ที่จะ Link ข้อมูลมาใช้คือ [รายชื่อประถม.xlsx] และชีตที่จะนำข้อมูลมาใช้คือ C1T1, C2T1 และถ้าไม่มีชีตชื่อนี้จะติด Error ครับ
Re: รบกวนช่วยตรวจสูตรครับ
Posted: Mon Aug 28, 2017 7:29 pm
by yangkodza
snasui wrote: เปลี่ยนบรรทัดนี้ครับ
ActiveCell.FormulaR1C1 = "='" & CurrDir & "\[รายชื่อประถม.xlsx]ป." & ClassRoom & "'!R3c2:r52C5"
เปลี่ยนเป็น
ActiveCell.FormulaR1C1 = "='" & CurrDir & "\[รายชื่อประถม.xlsx]" & ClassRoom & "'!R3c2:r52C5"
โดยไฟล์ที่จะ Link ข้อมูลมาใช้คือ [รายชื่อประถม.xlsx] และชีตที่จะนำข้อมูลมาใช้คือ C1T1, C2T1 และถ้าไม่มีชีตชื่อนี้จะติด Error ครับ
กำลังงงครับ ว่า แล้วดึงข้อมูลจากไฟล์ ส15101.xls แผ่นงาน C1T1, C2T1 มาตอนไหนครับ
ตอนนี้ยังดึงคะแนนไม่มาครับ
Re: รบกวนช่วยตรวจสูตรครับ
Posted: Mon Aug 28, 2017 7:49 pm
by snasui
ผมเขียนอธิบายไว้แล้วกรุณาอ่านทบทวนอีกครั้ง จะเป็นไฟล์ใดก็นำไปใช้ใน Code ได้ตามที่ต้องการ ขอให้ไฟล์นั้นมีชีต C1T1, C2T1 หรืออื่น ๆ ตามต้องการ
Re: รบกวนช่วยตรวจสูตรครับ
Posted: Mon Aug 28, 2017 8:52 pm
by yangkodza
snasui wrote: ผมเขียนอธิบายไว้แล้วกรุณาอ่านทบทวนอีกครั้ง จะเป็นไฟล์ใดก็นำไปใช้ใน Code ได้ตามที่ต้องการ ขอให้ไฟล์นั้นมีชีต C1T1, C2T1 หรืออื่น ๆ ตามต้องการ
Untitled.gif
ผมพยายามอ่านอย่างช้าๆ หลายครั้งแล้วครับ แต่ยังทำไม่ได้สักที
ตอนนี้ยังไม่ผ่านครับ
R3c2:r52C5 เป็นข้อมูล รายชื่อนักเรียน อย่างเดียว
ยังไม่มีการดึงคะแนนเข้ามาใน G2 ครับ
รบกวนช่วยดู มาโคร คะแนน ในไฟล์ ส15101.xls ด้วยครับ
ถ้า ชื่อแผ่นงานเป็น C1T1, C2T1
Re: รบกวนช่วยตรวจสูตรครับ
Posted: Mon Aug 28, 2017 9:34 pm
by snasui
แนบไฟล์ทั้งหมดมาใหม่ ด้วยชื่อชีตปัจจุบันที่ต้องการจะใช้งาน โดยได้ปรับ Code มาเองแล้ว จะได้ตอบต่อไปจากนั้นครับ
Re: รบกวนช่วยตรวจสูตรครับ
Posted: Mon Aug 28, 2017 10:35 pm
by yangkodza
01 ครูประจำชั้น.xls
ส15101.xls
รายชื่อประถม.xlsx
การทำงาน
เปิดไฟล์ 01 ครูประจำชั้น.xls
กดตัวการ์ตูนสีเขียว พิมพ์ 5-1 แล้วกด Enter
จะเจอหน้าต่างเลือกแผ่นงาน (ตรงส่วนนี้ต้องการให้ถ้าเราเลือก 5-1 ก็เรียกข้อมูลในแผ่นงาน C1t1 มาเลย
หรือถ้าเรา
กดตัวการ์ตูนสีเขียว พิมพ์ 5-2 แล้วกด Enter ก็เรียกข้อมูลในแผ่นงาน C2t1 มาเลย
โดยข้อมูลไปวางที่แผ่นงาน รวม 12 วิชา วางที่ Cell G2:G51 ครับ
ส่วนมาโครปัญหา
น่าจะเป็น มาโครชื่อคะแนน ในไฟล์ 01 ครูประจำชั้น.xls
Code: Select all
Sub คะแนน()
Sheets("รวม 12 วิชา").Select
' ส15101 สังคม
Range("G2").Select
ActiveCell.FormulaR1C1 = "=[ส15101.xls]C" & Right(Sheets("รายชื่อนักเรียน").Range("e3"), t1) & "!R[6]C[35]"
Selection.AutoFill Destination:=Range("G2:G51")
End Sub
ขอบคุณมากครับ
Re: รบกวนช่วยตรวจสูตรครับ
Posted: Mon Aug 28, 2017 10:41 pm
by snasui
ตัวอย่าง Code ครับ
Code: Select all
Sub เปลี่ยนห้อง()
'
' เปลี่ยนห้อง แมโคร
'
CurrDir = Application.ActiveWorkbook.Path
Classroom = InputBox("ตัวอย่าง ห้องเรียน ป.1/1 พิมพ์ 1-1")
'ClassRoom = o6
'
Range("b3").Select
ActiveCell.FormulaR1C1 = "='" & CurrDir & "\[รายชื่อประถม.xlsx]ป." & Classroom & "'!R3c2:r52C5"
Range("b3").Select
Selection.AutoFill Destination:=Range("b3:E3"), Type:=xlFillDefault
Range("b3:E3").Select
Selection.AutoFill Destination:=Range("b3:E52")
Range("b3:E52").Select
Range("b3").Select
'Call Module14.คะแนน
Sheets("รวม 12 วิชา").Select
' ส15101 สังคม
Range("G2").Select
If Classroom = "5-1" Then
ActiveCell.FormulaR1C1 = "=[ส15101.xls]" & "C1T1" & "!R[6]C[35]"
ElseIf Classroom = "5-2" Then
ActiveCell.FormulaR1C1 = "=[ส15101.xls]" & "C2T1" & "!R[6]C[35]"
End If
Selection.AutoFill Destination:=Range("G2:G51")
End Sub
Re: รบกวนช่วยตรวจสูตรครับ
Posted: Tue Aug 29, 2017 8:04 pm
by yangkodza
จากที่อาจารย์ปรับแก้ไขให้สามารถทำงานได้ดีครับ
Code: Select all
Sheets("รวม 12 วิชา").Select
' คะแนนสังคม เทอม1
Range("G2").Select
On Error Resume Next
Set WB = Workbooks("01สังคม_ป4.xlsm")
If Err <> 0 Then GoTo สุขศึกษา
If Classroom = "5-1" Then
ActiveCell.FormulaR1C1 = "=[01สังคม_ป4.xlsm]" & "สรุป1" & "!R[2]C[-5]" 'ok =B4
ElseIf Classroom = "5-2" Then
ActiveCell.FormulaR1C1 = "=[01สังคม_ป4.xlsm]" & "สรุป1" & "!R[2]C[-2]" 'ok =E4
ElseIf Classroom = "5-3" Then
ActiveCell.FormulaR1C1 = "=[01สังคม_ป4.xlsm]" & "สรุป1" & "!R[2]C[1]" 'ok =H4
ElseIf Classroom = "5-4" Then
ActiveCell.FormulaR1C1 = "=[01สังคม_ป4.xlsm]" & "สรุป1" & "!R[2]C[4]" 'ok =K4
ElseIf Classroom = "5-5" Then
ActiveCell.FormulaR1C1 = "=[01สังคม_ป4.xlsm]" & "สรุป1" & "!R[2]C[7]" 'ok =N4
End If
Selection.AutoFill Destination:=Range("G2:G51")
สุขศึกษา:
ActiveCell.FormulaR1C1 = "=[
01สังคม_ป4.xlsm]" & "สรุป1" & "!R[2]C[-5]" 'ok =B4
แต่ผมอยากปรับในส่วนของ code เพิ่มเติมให้กระชับขึ้น
โดยถ้าเราประกาศตัวแปรเข้าไป แล้วนำมาใช้งาน
ในส่วนที่ผมทำข้อความสีแดง ต้องปรับอย่างไรครับ
Re: รบกวนช่วยตรวจสูตรครับ
Posted: Tue Aug 29, 2017 9:40 pm
by snasui
yangkodza wrote:Set WB = Workbooks("01สังคม_ป4.xlsm")
ActiveCell.FormulaR1C1 = "=[01สังคม_ป4.xlsm]" & "สรุป1" & "!R[2]C[-5]" 'ok =B4
ตัวอย่างการปรับ Code ครับ
จาก
ActiveCell.FormulaR1C1 = "=[01สังคม_ป4.xlsm]" &...
ปรับเป็น
ActiveCell.FormulaR1C1 = "=["&WB.Name&"]" &...
Re: รบกวนช่วยตรวจสูตรครับ
Posted: Tue Aug 29, 2017 10:26 pm
by yangkodza
ขอถามเพิ่มเติมครับ
Code: Select all
ActiveCell.FormulaR1C1 = "=[01สังคม_ป4.xlsm]" & "สรุป1" & "!R[2]C[-5]" 'ok =B4
ถ้าเราต้องการอ้างอิงแบบปกติ ไม่เอารูปแบบ R1C1 เราต้องปรับสูตรอย่างไรครับ
จาก
คือ เซล B4
ขอบคุณครับ
Re: รบกวนช่วยตรวจสูตรครับ
Posted: Tue Aug 29, 2017 10:32 pm
by snasui
ตัวอย่างกาปรับ Code ครับ
ActiveCell.Formula = "=[01สังคม_ป4.xlsm]" & "สรุป1" & "!B4"
Re: รบกวนช่วยตรวจสูตรครับ
Posted: Tue Aug 29, 2017 11:23 pm
by yangkodza
snasui wrote: ตัวอย่างกาปรับ Code ครับ
ActiveCell.Formula = "=[01สังคม_ป4.xlsm]" & "สรุป1" & "!B4"
ส่วนนี้ทำได้แล้วครับ
ผมก็ติดอยู่นาน แก้แต่ทางด้านหลัง ไม่ได้แก้ที่ด้านหน้าด้วย
002.GIF
เหลือตรงตัวแปรครับ ลองใส่แล้วฟ้องข้อความแดงครับผม
Re: รบกวนช่วยตรวจสูตรครับ
Posted: Tue Aug 29, 2017 11:28 pm
by snasui
คีย์ให้มีวรรคคั่นระหว่างระหว่างเครื่องหมาย
& กับข้อความอื่นครับ
Re: รบกวนช่วยตรวจสูตรครับ
Posted: Tue Aug 29, 2017 11:37 pm
by yangkodza
ขอบคุณมากครับอาจารย์
ผมลองปรับกรณีเป็น 2 วิชา
สามารถทำงานได้ตามปกติ
พรุ่งนี้ค่อยเพิ่มวิชาที่เหลืออีกทีครับผม
นอนดึก แต่คุ้มค่ามากๆครับ
Re: รบกวนช่วยตรวจสูตรครับ
Posted: Fri Oct 13, 2017 5:07 pm
by yangkodza
ดึงคะแนนไม่ได้ครับ
ผมจะลองดึง 3 วิชา
ถ้ากรณีไม่เจอชื่อไฟล์ ก็ให้ไปดึงคะแนนถัดไปได้เลย
Code: Select all
Sub ดึง()
CurrDir = Application.ActiveWorkbook.Path
Classroom = [z4].Value
Range("J4").Select
On Error Resume Next
Set wb = Workbooks("01สังคม_ป1.xlsm")
If Err <> 0 Then GoTo สุขศึกษา
If Classroom = "1" Then
ActiveCell.Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง1เทอม1"
ElseIf Classroom = "2" Then
ActiveCell.Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง2เทอม1"
ElseIf Classroom = "3" Then
ActiveCell.Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง3เทอม1"
ElseIf Classroom = "4" Then
ActiveCell.Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง4เทอม1"
ElseIf Classroom = "5" Then
ActiveCell.Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง5เทอม1"
End If
Selection.AutoFill Destination:=Range("J4:J53"), Type:=xlFillDefault
สุขศึกษา:
Classroom = [z4].Value
Range("L4").Select
On Error Resume Next
Set wb = Workbooks("02สุขศึกษา_ป1.xlsm")
If Err <> 0 Then GoTo ศิลปะ
If Classroom = "1" Then
ActiveCell.Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง1เทอม1"
ElseIf Classroom = "2" Then
ActiveCell.Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง2เทอม1"
ElseIf Classroom = "3" Then
ActiveCell.Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง3เทอม1"
ElseIf Classroom = "4" Then
ActiveCell.Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง4เทอม1"
ElseIf Classroom = "5" Then
ActiveCell.Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง5เทอม1"
End If
Selection.AutoFill Destination:=Range("L4:L53"), Type:=xlFillDefault
ศิลปะ:
Classroom = [z4].Value
Range("M4").Select
On Error Resume Next
Set wb = Workbooks("03ศิลปะ_ป1.xlsm")
If Err <> 0 Then GoTo จบ
If Classroom = "1" Then
ActiveCell.Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง1เทอม1"
ElseIf Classroom = "2" Then
ActiveCell.Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง2เทอม1"
ElseIf Classroom = "3" Then
ActiveCell.Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง3เทอม1"
ElseIf Classroom = "4" Then
ActiveCell.Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง4เทอม1"
ElseIf Classroom = "5" Then
ActiveCell.Formula = "=[" & wb.Name & "]" & "สรุป1" & "!ห้อง5เทอม1"
End If
Selection.AutoFill Destination:=Range("M4:M53"), Type:=xlFillDefault
จบ:
End Sub
คะแนน.rar