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
Private Sub CommandButton1_Click()
Set cell_to = Cells(1, 1)
Set active_workbook = ActiveWorkbook
Set active_sheet = ActiveSheet
Application.DisplayAlerts = False
File_Path = "D:\MMCT\excel\"
strName = Dir(File_Path & "\" & "*.csv")
Do While strName <> vbNullString
Dim x
Dim y
Dim z
If active_workbook.Name <> strName And strName <> "" Then
Workbooks.Open Filename:=File_Path & "\" & strName
Set dataset_workbook = ActiveWorkbook
Call Macro1
dataset_workbook.Close
End If
strName = Dir
Loop
Application.DisplayAlerts = True
End Sub
Code: Select all
Sub Macro1()
'
' Macro1 Macro
'
'
Range("Z2:BG31").Select
Selection.Copy
y = 2
For i = 0 To 6
Windows("workbook.xlsm").Activate
Sheets("sheet2").Select
Cells(y, 1).Select
ActiveSheet.Paste
y = y + 30
i = i + 1
Next i
End Sub
Code: Select all
Dim wsh As Object
Set wsh = VBA.CreateObject("WScript.Shell")
Dim waitOnReturn As Boolean: waitOnReturn = True
Dim windowStyle As Integer: windowStyle = 1
wsh.Run "C:\folder\runbat.bat", windowStyle, waitOnReturn
ลองแนบตัวอย่าง CSV มาสักสองสามไฟล์ หากแนบไม่ได้ให้ทำการ Zip มาก่อน อธิายลักษณะการซ้ำมาด้วยว่ามีการซ้ำอย่างไร ต้องการให้แสดงคำตอบเป็นอย่างไรจะได้เข้าใจตรงกันครับnisit2559 wrote: คือต้องการที่จะนำไฟล์ .csv หลายๆไฟล์ในโฟดเดอร์เดียวกันมารวมกันในไฟล์ excel แล้วให้มาต่อกันครับผมทำได้แล้วแต่มันซ้ำค่ากันครับCode: Select all
Private Sub CommandButton1_Click() Set cell_to = Cells(1, 1) Set active_workbook = ActiveWorkbook Set active_sheet = ActiveSheet Application.DisplayAlerts = False File_Path = "D:\MMCT\excel\" strName = Dir(File_Path & "\" & "*.csv") Do While strName <> vbNullString Dim x Dim y Dim z If active_workbook.Name <> strName And strName <> "" Then Workbooks.Open Filename:=File_Path & "\" & strName Set dataset_workbook = ActiveWorkbook Call Macro1 dataset_workbook.Close End If strName = Dir Loop Application.DisplayAlerts = True End Sub
workbook.xlsmCode: Select all
Sub Macro1() ' ' Macro1 Macro ' ' Range("Z2:BG31").Select Selection.Copy y = 2 For i = 0 To 6 Windows("workbook.xlsm").Activate Sheets("sheet2").Select Cells(y, 1).Select ActiveSheet.Paste y = y + 30 i = i + 1 Next i End Sub
ขอบคุณครับmenem wrote:คุ้น ๆ ว่า กรณีนี้ตัวแปร y จะต้องถูกประกาศให้เป็น Global และมีการกำหนดค่าเพียงครั้งเดียว
(ที่เหลือค่อยเพิ่มขณะทำงาน) มิเช่นนั้น จะถูก Reset ให้เป็น 2 ทุกครั้งที่ Macro1 ถูกเรียกใช้งาน
แต่ถ้าเป็นผม ผมจะใช้ Shell เพื่อรวม .CSV ให้เป็นไฟล์เดียวก่อน จากนั้นจึงเปิดขึ้นมาในครั้งเดียวครับ
อ้างอิง : https://stackoverflow.com/questions/159 ... o-complete
แล้วในตัว runbat.bat เราสามารถใช้คำสั่งCode: Select all
Dim wsh As Object Set wsh = VBA.CreateObject("WScript.Shell") Dim waitOnReturn As Boolean: waitOnReturn = True Dim windowStyle As Integer: windowStyle = 1 wsh.Run "C:\folder\runbat.bat", windowStyle, waitOnReturn
copy *.csv xxx.out
แล้วเราค่อยเปิด xxx.out ใน vba อีกทีหนึ่ง
มันซ้ำกันตรงที่เวลาเปิดไฟล์ขึ้นมา1ไฟล์แล้วจะให้ copy ตรง Z2:BG31 แล้วให้นำไปวางที่ sheet 2 ที่ต่ำแหน่ง A2 แล้วจะให้เปิดไฟล์ต่อไปแล้ววางต่ำแหน่งA32 ต่อไปเรื่อยๆครับแต่พอผมทำแล้วมันจะเปิดมาแล้ววาง4ต่ำแหน่งพร้อมกันแล้วก็เปิดอีกหนึ่งไฟล์มาวางต่ำแหน่งเดิมครับแล้วก็วนจนครบมันก็จะได้แค่ไฟล์สุดท้ายครับ พอผมลองเอาโค้ดออกมานอก Macro1 แล้วก็ขึ้น Error 1004 ครับที่ โค้ด Cells(y, 1).Select ครับsnasui wrote:ลองแนบตัวอย่าง CSV มาสักสองสามไฟล์ หากแนบไม่ได้ให้ทำการ Zip มาก่อน อธิายลักษณะการซ้ำมาด้วยว่ามีการซ้ำอย่างไร ต้องการให้แสดงคำตอบเป็นอย่างไรจะได้เข้าใจตรงกันครับnisit2559 wrote: คือต้องการที่จะนำไฟล์ .csv หลายๆไฟล์ในโฟดเดอร์เดียวกันมารวมกันในไฟล์ excel แล้วให้มาต่อกันครับผมทำได้แล้วแต่มันซ้ำค่ากันครับCode: Select all
Private Sub CommandButton1_Click() Set cell_to = Cells(1, 1) Set active_workbook = ActiveWorkbook Set active_sheet = ActiveSheet Application.DisplayAlerts = False File_Path = "D:\MMCT\excel\" strName = Dir(File_Path & "\" & "*.csv") Do While strName <> vbNullString Dim x Dim y Dim z If active_workbook.Name <> strName And strName <> "" Then Workbooks.Open Filename:=File_Path & "\" & strName Set dataset_workbook = ActiveWorkbook Call Macro1 dataset_workbook.Close End If strName = Dir Loop Application.DisplayAlerts = True End Sub
workbook.xlsmCode: Select all
Sub Macro1() ' ' Macro1 Macro ' ' Range("Z2:BG31").Select Selection.Copy y = 2 For i = 0 To 6 Windows("workbook.xlsm").Activate Sheets("sheet2").Select Cells(y, 1).Select ActiveSheet.Paste y = y + 30 i = i + 1 Next i End Sub
Code: Select all
Private Sub CommandButton1_Click()
Set cell_to = Cells(1, 1)
Set active_workbook = ActiveWorkbook
Set active_sheet = ActiveSheet
Application.DisplayAlerts = False
File_Path = "D:\MMCT\excel\"
strName = Dir(File_Path & "\" & "*.csv")
Dim x
Dim y
Dim z
y = 2
Do While strName <> vbNullString
If active_workbook.Name <> strName And strName <> "" Then
Workbooks.Open Filename:=File_Path & "\" & strName
Set dataset_workbook = ActiveWorkbook
Range("Z2:BG31").Select
RowInc = Selection.Rows.Count
Selection.Copy
Windows("workbook.xlsm").Activate
Sheets("sheet2").Select
Cells(y, 1).Select
ActiveSheet.Paste
y = y + RowInc
dataset_workbook.Close
End If
strName = Dir
Loop
Application.DisplayAlerts = True
End Sub
menem wrote:ผมไม่แน่ใจว่า For I .... มีไว้ทำไมก็เลยเอาออกไปก่อนนะครับ
แล้วดึง macro1 กลับมาใน sub ตามเดิมก่อน
Code: Select all
Private Sub CommandButton1_Click() Set cell_to = Cells(1, 1) Set active_workbook = ActiveWorkbook Set active_sheet = ActiveSheet Application.DisplayAlerts = False File_Path = "D:\MMCT\excel\" มันขึ้นว่า erorr 1004 ครับต้องแก้อย่างไร strName = Dir(File_Path & "\" & "*.csv") Dim x Dim y Dim z y = 2 Do While strName <> vbNullString If active_workbook.Name <> strName And strName <> "" Then Workbooks.Open Filename:=File_Path & "\" & strName Set dataset_workbook = ActiveWorkbook Range("Z2:BG31").Select RowInc = Selection.Rows.Count Selection.Copy Windows("workbook.xlsm").Activate Sheets("sheet2").Select Cells(y, 1).Select ActiveSheet.Paste y = y + RowInc dataset_workbook.Close End If strName = Dir Loop Application.DisplayAlerts = True End Sub
ผมลองเปลี่ยนแล้วครับแต่ยัง erorr เหมือนเดิมครับmenem wrote:นี่คือไฟล์ที่ผมทดลองครับ
โดยไฟล์อยู่ที่ D:\MMCT\excel
ส่วนกรณีที่เกิด Error ไม่แน่ใจครับ ลองเปลี่ยน Path
จาก "D:\MMCT\excel\
ให้เป็น "D:\MMCT\excel"