- 帖子
- 43
- 主題
- 13
- 精華
- 0
- 積分
- 75
- 點名
- 0
- 作業系統
- windows 7
- 軟體版本
- office 2007
- 閱讀權限
- 20
- 註冊時間
- 2014-5-6
- 最後登錄
- 2019-6-17
|
[發問] 請問各位前輩關於多個excel設定欄位問題
不好意思、請問前輩們一下~
小弟此vba功能為針對同一個資料夾下的所有excel中的(Sheet1)的第9~14欄位進行設定欄位大小為(13.5)，
但因句集中"欄位轉換"使用open方式進行修改、故如果小弟的excel有超過50筆以上則需花上不少時間，
能否請問前輩、小弟的內容是否有其它方式可進行修改呢？
註：Sheet1為固定處理分頁
 轉換test檔.rar (19.19 KB)
感謝~
程式碼：(有點長..)
Sub 標案名稱轉換()
Sheets("轉換頁").[a2:a65535].ClearContents
Worksheets("轉換頁").Cells(1, 2) = ActiveWorkbook.Path
fs = Dir(Worksheets("轉換頁").Cells(1, 2) & "\*.*")
Do Until fs = ""
r = r + 1
Worksheets("轉換頁").Cells(r + 1, 1) = fs
fs = Dir
Loop
End Sub
Sub 標案名稱轉換1() '刪除其它非excel檔案
Dim LastRow As Long, r As Long
'判斷最後使用的列，將這個列數指派給 LastRow 變數
LastRow = Worksheets("轉換頁").UsedRange.Rows.Count
'LastRow 的計算方式：判斷使用範圍中的列數，加上使用範圍中第一個列數，再減去 1
LastRow = LastRow + Worksheets("轉換頁").UsedRange.Row - 1
Application.ScreenUpdating = False
'迴圈使用 Step -1 會由下而上進行處理，當刪除列之後會將所有下方的列往上移動。
'此區塊為刪除"非xl*檔"
For r = LastRow To 2 Step -1
If Worksheets("轉換頁").Cells(r, 1) Like "*xl*" Then
Else
Worksheets("轉換頁").Rows(r).Delete
End If
Next r
'此區塊為刪除"轉換test檔 "字列
For r = LastRow To 2 Step -1
If Worksheets("轉換頁").Cells(r, 1) Like "轉換test檔*" Then Worksheets("轉換頁").Rows(r).Delete
Next r
End Sub
Sub 欄位轉換()
Dim wb(1 To 2) As Workbook
Application.DisplayAlerts = False '是用來略過刪除時提醒的對話方塊, 若還要確認, 則可不用此指令
Set wb(1) = ThisWorkbook
For i = 2 To wb(1).Worksheets("轉換頁").[a65536].End(3).Row
Set wb(2) = Workbooks.Open(Worksheets("轉換頁").Cells(1, 2) & "\" & Worksheets("轉換頁").Cells(i, 1))
wb(2).Worksheets("Sheet1").Rows("9:14").Select
Selection.RowHeight = 13.5
wb(2).Close True
Next
Application.DisplayAlerts = True
Set wb(1) = Nothing
Set wb(2) = Nothing
End Sub
Sub 資料總呼叫()
Call 標案名稱轉換
Call 標案名稱轉換1
Call 欄位轉換
End Sub |
|
發表於 2014-9-17 17:56
| 
