本帖最後由 ffntldj 於 2011-12-1 20:17 編輯
遇到以下問題 上來詢問各位高手 請賜教 謝謝
以下是我寫的code (已完成部分)
主要的功能是想要去'C:\tool\output\ 此目錄下面開裡頭的*.XLS檔案,但開啟的檔案須符合以下條件
1:檔案名稱需要符合*檔名關鍵字* ,Word=[b2] 填寫在EXCEL表格中
2.Sheet名稱要符合"ShName",ShName=[b3] 填寫在EXCEL表格中
接下來是我不知道怎麼寫(未完成),煩請幫個忙 謝謝
3.打開檔案後在Sheet(Equi)中,當A+B+C欄位如果都一樣
則將此資料保留一筆(如附檔2,3列),也就是刪除重複的資料
4.在A欄位中只要有包含Filter1~3的內容時,要把資料刪除(假設filter1寫的是300#3_4MPMTR,則第六列整列刪除)
在'C:\tool\output\的裡面會有好幾個檔案 所以做完一個檔案 就要儲存 關掉,然後在做下一個
以下是小弟的code
Private Sub CommandButton11_click()
Dim sh As Worksheet,NewBK As Workbook
Dim Path$,Word$,ShName$,File$,Tmp$,Filter1$,Filter2$,Filter3$
Path=[b1] 'C:\tool\output\
Word=[b2] '檔名關鍵字
ShName=[b3] 'sheet name (Equi)
Filter1=[b4]
Filter2=[b5]
Filter3=[b6]
File= Dir(Path&"*.xls") '收尋檔案
if File="" then go to Ex
first =File
Do
Tmp=left(File,InStrRev(File,".")-1) '取檔案名
if InStr(File,Word) Then
Workbooks.open Path& File
On Error Resume Next
Set sh= ActiveWorkbook.Worksheets(ShName)
On Error GoTo 0
if Not sh is Nothing Then
i=i+1
'此段不會寫'
sh.Parent.Close False
End If
End If
File= Dir
Loop Until first = File Or File= ""
IF i Then
msgbox i&"筆符合檔案"
else
Newbk.close False
EX: Msgbox "無符合檔案"
End if
End Sub |
發表於 2011-11-29 21:49
| 
