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 ImportCSV()
Dim fileToOpen As Variant
Dim fileFilterPattern As String
Dim wsMaster As Worksheet
Dim wbTextImport As Workbook
Dim Sum As Integer
On Error Resume Next
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("DMC")
wsMaster.Range("A1:G1500").ClearContents
wbTextImport.Worksheets(1).Range("A1").CurrentRegion.Copy
wsMaster.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
wbTextImport.Close False
End If
Application.ScreenUpdating = True
Range("A2").Select
End Sub
Code: Select all
Sub ImportCSV()
Dim fileToOpen As Variant
Dim fileFilterPattern As String
Dim wsMaster As Worksheet
Dim wbTextImport As Workbook
Dim Sum As Integer
Dim cHead As Integer, tHead As String
Dim rHead As Worksheet
' On Error Resume Next
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("DMC")
wsMaster.Range("A1:G1500").ClearContents
Set rHead = wbTextImport.Worksheets(1)
cHead = Application.WorksheetFunction.CountA(wbTextImport.Worksheets(1).Range("1:1"))
tHead = rHead.Range("A1") & "_" & rHead.Range("B1") & "_" & rHead.Range("C1") & "_" & rHead.Range("D1") & "_" & rHead.Range("E1") & "_" & rHead.Range("F1") & "_" & rHead.Range("G1")
If cHead > 7 And tHead <> "เลขประจำตัวนักเรียน_ชั้น_ห้อง_เลขประจำตัวนักเรียน_คำนำหน้าชื่อ_ชื่อ_นามสกุล" Then
wbTextImport.Close False
MsgBox ("ไฟล์ที่คุณเลือก มีจำนวน หรือ ตำแหน่ง คอลัมภ์ผิดพลาด")
Else
wbTextImport.Worksheets(1).Range("A1").CurrentRegion.Copy
wsMaster.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
wbTextImport.Close False
End If
End If
Application.ScreenUpdating = True
Range("A2").Select
End Sub
Code: Select all
If cHead <> 7