ขอคำแนะนำ Code นำเข้าคะแนน

[tigerwit]

จากไฟล์ที่แนบ
โค๊ด

Code: Select all

Sub ImportScore()
  Dim fileToOpen As Variant
  Dim fileFilterPattern As String
  Dim wsMaster As Worksheet
  Dim wbTextImport As Workbook
  '
    If MsgBox("คุณต้องการนำเข้าเกรด ใช่หรือไม่?", 36, "ยืนยันการนำเข้าเกรด") = 6 Then
        Application.ScreenUpdating = False
        fileToOpen = Application.GetOpenFilename(Title:="เปิดไฟล์ .csv เพื่อนำเข้าข้อมูล", FileFilter:="Text Files (*.txt; *.csv),*.txt;*.csv")
        If fileToOpen = False Then
                MsgBox "คุณไม่ได้เลือกไฟล์ที่จะนำเข้า", vbOKOnly + vbInformation, "ยกเลิกการนำเข้าข้อมูล"
        Else
            Workbooks.Open Filename:=fileToOpen, UpdateLinks:=0, local:=True
                Set wbTextImport = ActiveWorkbook
                Set wsMaster = ThisWorkbook.ActiveSheet
'                wsMaster.Unprotect Password:="11651165"
                wsMaster.Range("F4:K54").ClearContents
                
                       wbTextImport.Worksheets(1).Range("A1:F50").Copy
                        wsMaster.Range("F4").PasteSpecial xlPasteValues
                                                
                        Application.CutCopyMode = False
                    wbTextImport.Close False
        Range("F4").Select
'                wsMaster.Protect Password:="11651165"
    End If
        End If
Exit Sub
        Application.ScreenUpdating = True
'                wsMaster.Protect Password:="11651165"
End Sub

ต้องการใช้โค๊ดด้านบนโค๊ดเดียว นำเข้าข้อมูลจากไฟล์ .csv ซึ่งเป็นไฟล์คะแนนนักเรียนทีละวิชา
จะต้องปรับโค๊ดอย่างไรครับ (ในวิชาที่ 1 ที่วางข้อมูลลงที่ F4 ทำได้) วิชาที่ 2 จะต้องวางลงที่ L4 วิชาที่ 3 วางลงที่ R4)

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub ImportScore()
    Dim fileToOpen As Variant
    Dim fileFilterPattern As String
    Dim wsMaster As Worksheet
    Dim wbTextImport As Workbook
    Dim tgRange As Range, sRange As Range
    Dim fName As String, subj As String
    If MsgBox("คุณต้องการนำเข้าเกรด ใช่หรือไม่?", 36, "ยืนยันการนำเข้าเกรด") = 6 Then
        Application.ScreenUpdating = False
        fileToOpen = Application.GetOpenFilename(Title:="เปิดไฟล์ .csv เพื่อนำเข้าข้อมูล", _
            FileFilter:="Text Files (*.txt; *.csv),*.txt;*.csv")
        If fileToOpen = False Then
            MsgBox "คุณไม่ได้เลือกไฟล์ที่จะนำเข้า", vbOKOnly + vbInformation, "ยกเลิกการนำเข้าข้อมูล"
        Else
            fName = VBA.Split(fileToOpen, "\")(UBound(VBA.Split(fileToOpen, "\")))
            subj = VBA.Mid(fName, 5, InStr(fName, " ม.") - 5)
            With Worksheets("Sheet1")
                If Application.CountIfs(.Range("2:2"), "*" & subj & "*") Then
                    Set tgRange = .Cells(4, Application.Match("*" & subj & "*", .Range("2:2"), 0))
                Else
                    Exit Sub
                End If
            End With
            Workbooks.Open Filename:=fileToOpen, UpdateLinks:=0, local:=True
            Set wbTextImport = ActiveWorkbook
            Set wsMaster = ThisWorkbook.ActiveSheet
            'wsMaster.Unprotect Password:="11651165"
            tgRange.Resize(50, 6).ClearContents
            'wbTextImport.Worksheets(1).Range("A1:F50").Copy
            Set sRange = wbTextImport.Worksheets(1).Range("A1:F50")
'            wsMaster.Range("F4").PasteSpecial xlPasteValues
            tgRange.Resize(sRange.Rows.Count, sRange.Columns.Count).Value = sRange.Value
                        
            Application.CutCopyMode = False
            wbTextImport.Close False
            Range("F4").Select
            'wsMaster.Protect Password:="11651165"
        End If
    End If
'    Exit Sub
    Application.ScreenUpdating = True
    'wsMaster.Protect Password:="11651165"
End Sub

[tigerwit]

ขอบคุณครับผม