[發問] 請問各位前輩關於多個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

樓主熱帖

luhpro

高中生 Rank: 3 Rank: 3

帖子: 835
主題: 6
精華: 0
積分: 915
點名: 14
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2024-11-6

2^#

發表於 2014-9-20 04:35 | 只看該作者

本帖最後由 luhpro 於 2014-9-20 04:50 編輯

不好意思、請問前輩們一下~
小弟此vba功能為針對同一個資料夾下的所有excel中的(Sheet1)的第9~14欄位進行設 ...
ii31sakura 發表於 2014-9-17 17:56

以下是個人的淺見,你可以參考看看:

1. 基本上要對檔案 "內容" 作變更應該都是要先開檔的,
除非你是用早期DOS時代低階寫入磁碟資料的方式來直接寫入磁面,
但這並不會被Windows系統接受,
也幾乎會被歸入是病毒的行為.

2. 善用 With...End With 來取代需 "被重複使用" 的 "物件",
善用 "變數" 來取代需 "被重複使用" 的 "計算結果",
尤其是 For...Next 或 Do...Loop ...等迴圈中經常會參考到的東西,
速度較快也有利於程式碼的辨識與除錯,
當然若只使用一次, 那就別用了.

3. 除非必需要用到(例如使用者需要看到, 或某些需要參照到現用物件的專屬指令碼),
否則 Select 或 Activate 指令請儘量少用,
那會浪費一些非必要的時間(尤其是在迴圈中, 會重複執行很多次的情形).

4. 程式碼可以適當使用縮排(左端加空格)與空白行, 增加辨識與除錯的便利性.

程式修改如下,因無資料可以先行測試結果,若有問題再請提出:

Sub 標案名稱轉換()
With Sheets("轉換頁")
.[a2:a65535].ClearContents
.Cells(1, 2) = ActiveWorkbook.Path
fs = Dir(.Cells(1, 2) & "\*.*")
Do Until fs = ""
r = r + 1
.Cells(r + 1, 1) = fs
fs = Dir
Loop
End With
End Sub
Sub 標案名稱轉換1() '刪除其它非excel檔案
Dim LastRow As Long, r As Long
'判斷最後使用的列，將這個列數指派給 LastRow 變數
With Worksheets("轉換頁")
LastRow = .UsedRange.Rows.Count
'LastRow 的計算方式：判斷使用範圍中的列數，加上使用範圍中第一個列數，再減去 1
LastRow = LastRow + .UsedRange.Row - 1
Application.ScreenUpdating = False
'迴圈使用 Step -1 會由下而上進行處理，當刪除列之後會將所有下方的列往上移動。
'此區塊為刪除"非xl*檔"
For r = LastRow To 2 Step -1
If .Cells(r, 1) Like "*xl*" Then
Else
.Rows(r).Delete
End If
Next r
'此區塊為刪除"轉換test檔 "字列
For r = LastRow To 2 Step -1
If .Cells(r, 1) Like "轉換test檔*" Then .Rows(r).Delete
Next r
End With
End Sub
Sub 欄位轉換()
Dim lRows&
Dim wb As Workbook
Application.DisplayAlerts = False '是用來略過刪除時提醒的對話方塊, 若還要確認, 則可不用此指令
With ThisWorkbook.Worksheets("轉換頁")
lRows = .[a65536].End(3).Row
For i = 2 To lRows
Set wb = Workbooks.Open(.Cells(1, 2) & "\" & .Cells(i, 1))
wb.Worksheets("Sheet1").Rows("9:14").RowHeight = 13.5
wb.Close True
Next
End With
Application.DisplayAlerts = True
Set wb = Nothing
End Sub
Sub 資料總呼叫()
Call 標案名稱轉換
Call 標案名稱轉換1
Call 欄位轉換
End Sub

複製代碼

TOP

ii31sakura

中學生 Rank: 2

帖子: 43
主題: 13
精華: 0
積分: 75
點名: 0
作業系統: windows 7
軟體版本: office 2007
閱讀權限: 20
註冊時間: 2014-5-6
最後登錄: 2019-6-17

3^#

發表於 2014-9-22 09:32 | 只看該作者

回復 2# luhpro

感謝luhpro前輩細心指導、這個方式執行起來跟原本的執行速度相差好幾倍..尤其是在多檔案情況下時間差距更明顯，
感謝前輩的幫忙指導~

TOP