返回列表 上一主題 發帖

[發問] 請問各位前輩關於多個excel設定欄位問題

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
1# 跳轉到 »
發表於 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. 程式碼可以適當使用縮排(左端加空格)與空白行, 增加辨識與除錯的便利性.

程式修改如下,因無資料可以先行測試結果,若有問題再請提出:
  1. Sub 標案名稱轉換()
  2.   With Sheets("轉換頁")
  3.     .[a2:a65535].ClearContents
  4.     .Cells(1, 2) = ActiveWorkbook.Path
  5.     fs = Dir(.Cells(1, 2) & "\*.*")
  6.     Do Until fs = ""
  7.       r = r + 1
  8.       .Cells(r + 1, 1) = fs
  9.       fs = Dir
  10.     Loop
  11.   End With
  12. End Sub

  14. Sub 標案名稱轉換1() '刪除其它非excel檔案
  15.   Dim LastRow As Long, r As Long
  16.     '判斷最後使用的列，將這個列數指派給 LastRow 變數

  18.   With Worksheets("轉換頁")
  19.     LastRow = .UsedRange.Rows.Count
  20.     'LastRow 的計算方式：判斷使用範圍中的列數，加上使用範圍中第一個列數，再減去 1
  21.     LastRow = LastRow + .UsedRange.Row - 1
  22.     Application.ScreenUpdating = False
  23.     '迴圈使用 Step -1 會由下而上進行處理，當刪除列之後會將所有下方的列往上移動。
  24.     '此區塊為刪除"非xl*檔"
  25.     For r = LastRow To 2 Step -1
  26.        If .Cells(r, 1) Like "*xl*" Then
  27.        Else
  28.          .Rows(r).Delete
  29.        End If
  30.     Next r
  31.   '此區塊為刪除"轉換test檔 "字列
  32.     For r = LastRow To 2 Step -1
  33.       If .Cells(r, 1) Like "轉換test檔*" Then .Rows(r).Delete
  34.     Next r
  35.   End With
  36. End Sub

  38. Sub 欄位轉換()
  39.   Dim lRows&
  40.   Dim wb As Workbook
  41.    
  42.   Application.DisplayAlerts = False '是用來略過刪除時提醒的對話方塊, 若還要確認, 則可不用此指令
  43.   With ThisWorkbook.Worksheets("轉換頁")
  44.     lRows = .[a65536].End(3).Row
  45.     For i = 2 To lRows
  46.       Set wb = Workbooks.Open(.Cells(1, 2) & "\" & .Cells(i, 1))
  47.        wb.Worksheets("Sheet1").Rows("9:14").RowHeight = 13.5
  48.       wb.Close True
  49.     Next
  50.   End With
  51.   Application.DisplayAlerts = True
  52.   Set wb = Nothing
  53. End Sub

  55. Sub 資料總呼叫()
  56.     Call 標案名稱轉換
  57.     Call 標案名稱轉換1
  58.     Call 欄位轉換
  59. End Sub
複製代碼

TOP

        靜思自在 : 是非當教育，讚美作警惕。
返回列表 上一主題