Page 1 of 1

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

Posted: Sun Oct 16, 2022 7:46 pm
by 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)

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

Posted: Mon Oct 17, 2022 6:27 am
by snasui
:D ตัวอย่างการปรับ 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

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

Posted: Tue Oct 18, 2022 4:22 pm
by tigerwit
ขอบคุณครับผม