ขอความช่วยเหลือ CodeVB Export-Import ไฟล์ .csv

[tigerwit]

จากไฟล์ที่แนบ (ImPCSV.xlsb)

Code: Select all

Sub SaveRangeToCSV()

    Dim myCSVFileName As String
    Dim myWB As Workbook
    Dim tempWB As Workbook
    Dim rngToSave As Range

    Application.DisplayAlerts = False
    On Error GoTo err

    Set myWB = ThisWorkbook
    myCSVFileName = myWB.Path & "\" & "Score" & VBA.Format(VBA.Now, "dd-MMM-yyyy") & ".csv"
'    Set rngToSave = Range("F6:S50")
    Set rngToSave = Range("F6:S50,U6:V50,Z6:AM50,AO6:AP50")
    rngToSave.Copy
    Set tempWB = Application.Workbooks.Add(1)
    With tempWB
        .Sheets(1).Range("A1").PasteSpecial xlPasteValues
        .SaveAs Filename:=myCSVFileName, FileFormat:=xlCSV, CreateBackup:=False
        .Close
    End With

err:
    Application.DisplayAlerts = True
End Sub

1. ส่งออกเป็นไฟล์ .csv ได้ (Score19-เม.ย.-2565.csv)
แต่ยังไม่ตรงกับความต้องการ เพราะข้อมูลที่ส่งออกมานั้นเรียงติดกันทุกคลอลัมน์
ที่ต้องการคือ ให้มีเว้นว่างในคลอลัมน์ O R S T และ AI (เหมือนไฟล์ Exsam1.csv)
จะต้องปรับ Code อย่างไรครับ
2.

Code: Select all

Sub ImportCSVFile()
  Dim fileToOpen As Variant
  Dim fileFilterPattern As String
  Dim wsMaster As Worksheet
  Dim wbTextImport As Workbook
  '
  Application.ScreenUpdating = False
    fileFilterPattern = "Text Files (*.txt; *.csv),*.txt;*.csv"
  fileToOpen = Application.GetOpenFilename(fileFilterPattern)
  If fileToOpen = False Then
    MsgBox "คุณไม่ได้เลือกไฟล์ที่จะนำเข้า", vbOKOnly + vbInformation, "ยกเลิกการนำเข้าข้อมูล"
  Else
    Workbooks.Open Filename:=fileToOpen, UpdateLinks:=0, Local:=True
    Set wbTextImport = ActiveWorkbook
    Set wsMaster = ThisWorkbook.Worksheets("ภาษาไทย2")
    wsMaster.Range("F6:S50,U6:V50,Z6:AM50,AO6:AP50").ClearContents
    wbTextImport.Worksheets(1).Range("A1").CurrentRegion.Copy
    wsMaster.Range("F6").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    wbTextImport.Close False
  End If
  Application.ScreenUpdating = True
  Range("F6").Select
End Sub

2.จาก Code ต้องการนำเข้าไฟล์ .csv ไปยังชีท ภาษาไทย2
โดยให้ตัวเลขที่นำเข้ามานั้นวางลงในเซลล์ที่ไม่ได้ถูกล็อค ("F6:S50,U6:V50,Z6:AM50,AO6:AP50")

[snasui]

1. ส่งออกเป็นไฟล์ .csv ได้ (Score19-เม.ย.-2565.csv)
แต่ยังไม่ตรงกับความต้องการ เพราะข้อมูลที่ส่งออกมานั้นเรียงติดกันทุกคลอลัมน์
ที่ต้องการคือ ให้มีเว้นว่างในคลอลัมน์ O R S T และ AI (เหมือนไฟล์ Exsam1.csv)

ลองปรับส่วนที่เป็นการ Save เป็น

.SaveAs Filename:=myCSVFileName, FileFormat:=xlCSV, CreateBackup:=False, local:=True ดูครับ

2.จาก Code ต้องการนำเข้าไฟล์ .csv ไปยังชีท ภาษาไทย2
โดยให้ตัวเลขที่นำเข้ามานั้นวางลงในเซลล์ที่ไม่ได้ถูกล็อค ("F6:S50,U6:V50,Z6:AM50,AO6:AP50")

จาก Code

Code: Select all

'Other code
wbTextImport.Worksheets(1).Range("A1").CurrentRegion.Copy
    wsMaster.Range("F6").PasteSpecial xlPasteValues
    'Other code

เป็นการ Copy ข้อมูลทั้งหมดมาวางทับยังตำแหน่งเดียว แต่ในการทำงานจริงเป็นการทำงานกับหลายพื้นที่ ดังนั้น จะต้องเลือก Copy ทีละพื้นและวางที่ให้ตรงกับตำแหน่งปลายทาง ซึ่งสามารถ Copy และ Paste ได้หลายครั้งจนครบตามตำแหน่งที่ต้องการ ลองปรับ Code มาเองก่อน ติดตรงไหนค่อยนำมาถามกันต่อครับ

[tigerwit]

'Other code
wbTextImport.Worksheets(1).Range("A1").CurrentRegion.Copy
wsMaster.Range("F6").PasteSpecial xlPasteValues
'Other code
เป็นการ Copy ข้อมูลทั้งหมดมาวางทับยังตำแหน่งเดียว แต่ในการทำงานจริงเป็นการทำงานกับหลายพื้นที่ ดังนั้น จะต้องเลือก Copy ทีละพื้นและวางที่ให้ตรงกับตำแหน่งปลายทาง ซึ่งสามารถ Copy และ Paste ได้หลายครั้งจนครบตามตำแหน่งที่ต้องการ ลองปรับ Code มาเองก่อน ติดตรงไหนค่อยนำมาถามกันต่อครับ

ไล่ไปเป็นชุด

Code: Select all

'Other code
    wbTextImport.Worksheets(1).Range("A1").CurrentRegion.Copy
    wsMaster.Range("F6:S50").PasteSpecial xlPasteValues
        wbTextImport.Worksheets(1).Range("P1").CurrentRegion.Copy
    wsMaster.Range("U6:V50").PasteSpecial xlPasteValues
................................................................................
   'Other code

ใช่หรือไม่ครับ

สอบถามเพิ่มเรื่องการตั้งชื่อไฟล์ตอนส่งออกครับ

Code: Select all

myCSVFileName = myWB.Path & "\" & "Score" & VBA.Format(VBA.Now, "dd-MMM-yyyy") & ".csv"

ต้องการเปลี่ยนจากตั้งชื่อ Score เป็นชื่อชีทที่ส่งออก และให้ครูผู้ใช้งานเลือกว่าจะ Save ไฟล์ไว้ที่ไหน

[snasui]

Code: Select all

wbTextImport.Worksheets(1).Range("A1").CurrentRegion.Copy

การ Copy ก็ต้องเลือกช่วงเซลล์เป้าหมายที่ไม่ใช่ .CurrentRegion เพราะหมายถึงพื้นที่ที่ติดกับเซลล์ที่เลือก หากข้อมูลติดกันหลายบรรทัดหลายคอลัมน์ก็จะเป็นการ Copy มาทั้งหมดจึงควรเลือกเฉพาะพื้นที่ที่เป็นต้นทางเท่านั้น

การตั้งชื่อไฟล์ด้วยชื่อชีต สามารถใช้ Statement myWB.Worksheets("xyz").Name เพื่อแสดงชื่อชีต xyz ของไฟล์ myWb เช่นนี้เป็นต้นครับ

[tigerwit]

สวัสดีครับ
ปรับแก้ Code แล้วมีคำถามต่อครับ
จากไฟล์มีชีททั้งหมด 12 ชีท
การส่งออกคะแนน เป็น .csv
ไม่มีปัญหา 1 Code ใช้กับ 12 ชีทได้
แต่ การนำเข้าจา code

Code: Select all

Sub ImportCSV()
  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.Worksheets("Math")
                wsMaster.Unprotect Password:="1165"
                wsMaster.Range("F6:S50,U6:V50,Z6:AM50,AO6:AP50").ClearContents
                       wbTextImport.Worksheets(1).Range("A1:N50").Copy
                        wsMaster.Range("F6").PasteSpecial xlPasteValues
                    wbTextImport.Worksheets(1).Range("O1:P50").Copy
                        wsMaster.Range("U6").PasteSpecial xlPasteValues
                    wbTextImport.Worksheets(1).Range("Q1:AD50").Copy
                        wsMaster.Range("Z6").PasteSpecial xlPasteValues
                    wbTextImport.Worksheets(1).Range("AE1:AF50").Copy
                        wsMaster.Range("AO6").PasteSpecial xlPasteValues
                        Application.CutCopyMode = False
                    wbTextImport.Close False
        Range("F6").Select
                wsMaster.Protect Password:="1165"
    End If
        End If
Exit Sub
        Application.ScreenUpdating = True
                wsMaster.Protect Password:="1165"
End Sub

จะปรับแก้ Code อย่างไร เพื่อให้ 1 Code ใช้ได้กับ 12 ชีท

[snasui]

กำหนดชื่อแต่ละชีตในไฟล์ที่เป็นนามสกุล .csv ให้ตรงกับชื่อแต่ละชีตของไฟล์ ImPCSV.xlsm จากนั้นที่ Statement Set wsMaster = ThisWorkbook.Worksheets("Math") เปลี่ยนเป็น Set wsMaster = ThisWorkbook.Worksheets(wbTextImport.Sheets(1).Name) ครับ

[tigerwit]

ขอบคุณครับผม
ได้แนวทางทำงานต่อไปมากเลยครับ