EXCEL TOOLS
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
[code]
และปิดด้วย [/code]
ตัวอย่างเช่น [code]dim r as range[/code]
เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)Code: Select all
Sub Import()
Dim fileToOpen As Variant
Dim fileFilterPattern As String
Dim wsMaster As Worksheet
Dim wbTextImport As Workbook
'
Application.ScreenUpdating = False
If MsgBox("คุณต้องการนำเข้าผลการเรียน ใช่หรือไม่?", 36, "ยืนยันการนำเข้าผลการเรียน") = 6 Then
fileToOpen = Application.GetOpenFilename(Title:="เปิดไฟล์ .csv เพื่อนำเข้าข้อมูล", FileFilter:="Text Files (*.txt; *.csv),*.txt;*.csv")
End If
If fileToOpen = False Then
MsgBox "คุณไม่ได้เลือกไฟล์ที่จะนำเข้า", vbOKOnly + vbInformation, "ยกเลิกการนำเข้าข้อมูล"
Exit Sub
Else
Workbooks.Open Filename:=fileToOpen, UpdateLinks:=0, local:=True
Set wbTextImport = ActiveWorkbook
Set wsMaster = ThisWorkbook.ActiveSheet
wbTextImport.Worksheets(1).Range("A1:N45").Copy
Range("F" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
wbTextImport.Worksheets(1).Range("O1:P45").Copy
Range("U" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
wbTextImport.Worksheets(1).Range("Q1:AD45").Copy
Range("Z" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
wbTextImport.Worksheets(1).Range("AE1:AF45").Copy
Range("AO" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
wbTextImport.Close False
Range("F6").Select
MsgBox "นำเข้าคะแนนเรียบร้อยแล้ว"
End If
Application.ScreenUpdating = True
End Sub
Code: Select all
'Other code
Else
Workbooks.Open Filename:=fileToOpen, UpdateLinks:=0, local:=True
Set wbTextImport = ActiveWorkbook
Set wsMaster = ThisWorkbook.ActiveSheet
wbTextImport.Worksheets(1).Range("A1:N45").Copy
wsMaster.Range("F" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
wbTextImport.Worksheets(1).Range("O1:P45").Copy
wsMaster.Range("U" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
wbTextImport.Worksheets(1).Range("Q1:AD45").Copy
wsMaster.Range("Z" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
wbTextImport.Worksheets(1).Range("AE1:AF45").Copy
wsMaster.Range("AO" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
'Other code
Code: Select all
Sub test()
Range(Range("A1"), Range("N1").End(xlDown)).Select
End Sub
Code: Select all
Dim rw As Long
With Worksheets("Sheet1")
rw = .Range("a" & .Rows.Count).End(xlUp).Row
.Range("N1:N" & rw).Select
End With
Code: Select all
Sub ImPortToLastrows()
Dim fileToOpen As Variant
Dim fileFilterPattern As String
Dim wsMaster As Worksheet
Dim wbTextImport As Workbook
Dim rw As Long
Dim rg As Long
'
Application.ScreenUpdating = False
If MsgBox("คุณต้องการนำผลการเรียนจากห้อง 2 มาต่อท้ายห้อง 1 ใช่หรือไม่?", 36, "ยืนยันการนำผลการเรียนมารวมเป็นห้องเดียว") = 6 Then
fileToOpen = Application.GetOpenFilename(Title:="เปิดไฟล์ .csv เพื่อนำเข้าข้อมูล", FileFilter:="Text Files (*.txt; *.csv),*.txt;*.csv")
End If
If fileToOpen = False Then
MsgBox "คุณไม่ได้เลือกไฟล์ที่จะนำเข้า", vbOKOnly + vbInformation, "ยกเลิกการนำเข้าข้อมูล"
Exit Sub
rg = wsMaster.Range("B" & Rows.Count).End(xlUp).Row
If Range("B" & rg).Value = "" Then
MsgBox "ไม่มีนักเรียนให้นำเข้าคะแนน", vbOKOnly + vbInformation, "ยกเลิกการนำเข้าข้อมูล"
Exit Sub
End If
Else
Workbooks.Open Filename:=fileToOpen, UpdateLinks:=0, local:=True
Set wbTextImport = ActiveWorkbook
Set wsMaster = ThisWorkbook.ActiveSheet
With wbTextImport.Worksheets(1)
rw = .Range("a" & .Rows.Count).End(xlUp).Row
.Range("A1:N" & rw).Copy
wsMaster.Range("F" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
.Range("O1:P" & rw).Copy
wsMaster.Range("U" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
.Range("Q1:AD" & rw).Copy
wsMaster.Range("Z" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
.Range("AE1:AF" & rw).Copy
wsMaster.Range("AO" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
wbTextImport.Close False
Range("F6").Select
End If
Application.ScreenUpdating = True
MsgBox "นำเข้าคะแนนเรียบร้อยแล้ว"
End Sub
Code: Select all
'Other code
If MsgBox("คุณต้องการนำผลการเรียนจากห้อง 2 มาต่อท้ายห้อง 1 ใช่หรือไม่?", 36, "ยืนยันการนำผลการเรียนมารวมเป็นห้องเดียว") = 6 Then
fileToOpen = Application.GetOpenFilename(Title:="เปิดไฟล์ .csv เพื่อนำเข้าข้อมูล", FileFilter:="Text Files (*.txt; *.csv),*.txt;*.csv")
End If
If fileToOpen = False Then
MsgBox "คุณไม่ได้เลือกไฟล์ที่จะนำเข้า", vbOKOnly + vbInformation, "ยกเลิกการนำเข้าข้อมูล"
Exit Sub
Else
Set wsMaster = ThisWorkbook.ActiveSheet
rg = wsMaster.Range("B" & Rows.Count).End(xlUp).Row
If Range("B" & rg).Value = "" Then
MsgBox "ไม่มีนักเรียนให้นำเข้าคะแนน", vbOKOnly + vbInformation, "ยกเลิกการนำเข้าข้อมูล"
Exit Sub
End If
'Other code