返回列表 上一主題 發帖

想請問關於一些自動化格式設定的問題

想請問關於一些自動化格式設定的問題

因有許多份文件但其格式大致相同,只有活頁簿數量不同
因為欄位大致相同 只是有些有新增和減少
欄寬有些些許變化而已

(巨集 程式碼包含 取代、自動新增活頁簿、設定欄寬、列寬 )


想請問說以下的程式碼是否可以簡化(能的話能附註些許說明嗎?)
因為權限尚不足 所以只能貼上程式碼...
麻煩各位高手了 謝謝

'-------區分-頭
For Each s In Sheets


    Sheets("一").Select
If s.Name = "一" Then

'-----更換關鍵字-頭----------
    Cells.Replace What:="AU", Replacement:="='C:\U", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
'-----更換關鍵字-尾-----------

'------列高-頭
            Rows("1:600").Select
            Selection.RowHeight = 20
'-------列高-尾

'-------爛位調整寬度-頭
        Columns("a:a").Select
        Selection.ColumnWidth = 14
        Columns("b:b").Select
        Selection.ColumnWidth = 30
        Columns("c:c").Select
        Selection.ColumnWidth = 26
        Columns("d:d").Select
        Selection.ColumnWidth = 12
        Columns("e:e").Select
        Selection.ColumnWidth = 50
        Columns("f:f").Select
        Selection.ColumnWidth = 10
        Columns("g:g").Select
        Selection.ColumnWidth = 20
        Columns("h:h").Select
        Selection.ColumnWidth = 10
        Columns("i:i").Select
        Selection.ColumnWidth = 20
        Columns("j:j").Select
        Selection.ColumnWidth = 10
        Columns("k:k").Select
        Selection.ColumnWidth = 20
        Columns("l:l").Select
        Selection.ColumnWidth = 10
         Columns("m:m").Select
        Selection.ColumnWidth = 20
        Columns("n:n").Select
        Selection.ColumnWidth = 30
        Columns("o:o").Select
        Selection.ColumnWidth = 30
        Columns("p:p").Select
        Selection.ColumnWidth = 60
        Columns("q:q").Select
        Selection.ColumnWidth = 60
        Columns("r:r").Select
        Selection.ColumnWidth = 26
         Columns("s:s").Select
        Selection.ColumnWidth = 18
        Columns("t:t").Select
        Selection.ColumnWidth = 14
        Columns("u:u").Select
        Selection.ColumnWidth = 12
        Columns("v:v").Select
        Selection.ColumnWidth = 18
        Columns("w:w").Select
        Selection.ColumnWidth = 14
        Columns("x:x").Select
        Selection.ColumnWidth = 14
        Columns("y:y").Select
        Selection.ColumnWidth = 50
'------欄位調整寬度-尾


'------欄位格式調整-頭
        Columns("A:z").Select
        With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
       End With
'-------欄位格式調整-尾

    Exit For
End If
Next

'-------區分-尾



'-------區分-頭
For Each s In Sheets

If s.Name = "二" Then

                  
        
    Sheets("二").Select
    Cells.Replace What:="AU", Replacement:="='C:\U", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
            Rows("1:600").Select
            Selection.RowHeight = 20

        Columns("a:a").Select
        Selection.ColumnWidth = 14
        Columns("b:b").Select
        Selection.ColumnWidth = 30
        Columns("c:c").Select
        Selection.ColumnWidth = 26
        Columns("d:d").Select
        Selection.ColumnWidth = 12
        Columns("e:e").Select
        Selection.ColumnWidth = 50
        Columns("f:f").Select
        Selection.ColumnWidth = 10
        Columns("g:g").Select
        Selection.ColumnWidth = 20
        Columns("h:h").Select
        Selection.ColumnWidth = 10
        Columns("i:i").Select
        Selection.ColumnWidth = 20
        Columns("j:j").Select
        Selection.ColumnWidth = 10
        Columns("k:k").Select
        Selection.ColumnWidth = 20
        Columns("l:l").Select
        Selection.ColumnWidth = 10
         Columns("m:m").Select
        Selection.ColumnWidth = 20
        Columns("n:n").Select
        Selection.ColumnWidth = 30
        Columns("o:o").Select
        Selection.ColumnWidth = 30
        Columns("p:p").Select
        Selection.ColumnWidth = 60
        Columns("q:q").Select
        Selection.ColumnWidth = 60
        Columns("r:r").Select
        Selection.ColumnWidth = 26
         Columns("s:s").Select
        Selection.ColumnWidth = 18
        Columns("t:t").Select
        Selection.ColumnWidth = 14
        Columns("u:u").Select
        Selection.ColumnWidth = 12
        Columns("v:v").Select
        Selection.ColumnWidth = 18
        Columns("w:w").Select
        Selection.ColumnWidth = 14
        Columns("x:x").Select
        Selection.ColumnWidth = 14
        Columns("y:y").Select
        Selection.ColumnWidth = 50
            
        Columns("A:z").Select
        With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
       End With
              


    Exit For
End If
Next

'-------區分-尾

剛剛試了一下 可以使用 再次感謝 Hsieh大大~
不過 對於一點不是很了解
11.Case Is < 5  <== 這行的 IS  是??
我看得懂這行的意思 只是對於那個不清楚 (應該不會單純只是英文的 IS(是) 吧...)

TOP

回復 9# Hsieh


    就如同檔案內所附 有些活頁簿的資料欄位並不需要那麼多
     例如 第一個活頁簿 的欄位(包含號碼欄 從 A 到 Y)
           第4或5的活頁簿 只需要 A到 J  而已
      因之前有想過用那個方法 只是語法不太熟悉就沒用
      感謝大大所提供的方法

TOP

回復 8# mark15jill
檔案是沒問題,不過你的敘述要讓人看懂恐怕很難
我認為你是依照工作表名稱(或序列號)判斷哪些欄位的寬度設定
所以,基本上可用Select case 來簡化程式
  1. Sub nn()
  2. Dim Sh As Worksheet
  3. For Each Sh In Sheets
  4. With Sh
  5.         .Columns("a").ColumnWidth = 14
  6.         .Columns("b").ColumnWidth = 32
  7.         .Columns("c").ColumnWidth = 26
  8.         .Columns("d").ColumnWidth = 12
  9.         .Columns("e").ColumnWidth = 50
  10. Select Case .Index
  11. Case Is < 5
  12.         .Columns("s").ColumnWidth = 18
  13.         .Columns("t").ColumnWidth = 14
  14.         .Columns("u").ColumnWidth = 12
  15.         .Columns("v").ColumnWidth = 18
  16.         .Columns("w").ColumnWidth = 14
  17.         .Columns("x").ColumnWidth = 14
  18.         .Columns("y").ColumnWidth = 60
  19. Case Is < 6
  20.         .Columns("f").ColumnWidth = 10
  21.         .Columns("g").ColumnWidth = 24
  22.         .Columns("h").ColumnWidth = 10
  23.         .Columns("i").ColumnWidth = 24
  24.         .Columns("j").ColumnWidth = 10
  25.         .Columns("k").ColumnWidth = 24
  26.         .Columns("l").ColumnWidth = 10
  27.         .Columns("m").ColumnWidth = 20
  28.         .Columns("n").ColumnWidth = 30
  29.         .Columns("o").ColumnWidth = 30
  30.         .Columns("p").ColumnWidth = 60
  31.         .Columns("q").ColumnWidth = 60
  32.         .Columns("r").ColumnWidth = 26
  33. Case 5
  34.         .Columns("s").ColumnWidth = 12
  35.         .Columns("t").ColumnWidth = 60
  36. Case 6
  37.         .Columns("f").ColumnWidth = 20
  38.         .Columns("g").ColumnWidth = 20
  39.         .Columns("h").ColumnWidth = 50
  40.         .Columns("i").ColumnWidth = 20
  41.         .Columns("j").ColumnWidth = 60
  42. Case 7
  43.         .Columns("f").ColumnWidth = 10
  44.         .Columns("g").ColumnWidth = 24
  45.         .Columns("h").ColumnWidth = 10
  46.         .Columns("i").ColumnWidth = 24
  47.         .Columns("j").ColumnWidth = 10
  48.         .Columns("k").ColumnWidth = 24
  49.         .Columns("l").ColumnWidth = 10
  50.         .Columns("m").ColumnWidth = 20
  51.         .Columns("n").ColumnWidth = 30
  52.         .Columns("o").ColumnWidth = 30
  53.         .Columns("p").ColumnWidth = 60
  54.         .Columns("q").ColumnWidth = 60
  55.         .Columns("r").ColumnWidth = 26
  56.         .Columns("s").ColumnWidth = 18
  57.         .Columns("t").ColumnWidth = 14
  58.         .Columns("u").ColumnWidth = 12
  59.         .Columns("v").ColumnWidth = 18
  60.         .Columns("w").ColumnWidth = 14
  61.         .Columns("x").ColumnWidth = 14
  62.         .Columns("y").ColumnWidth = 60
  63. End Select
  64. End With
  65. Next
  66. End Sub
複製代碼
學海無涯_不恥下問

TOP

請問下載成功嗎 很怕錯誤..

TOP

原來小學生的權限可以上傳阿... -.-  (始終認為不能...
有把格式和差異處用顏色標示
檔案有兩個EXCEL
一個為 差異處顏色解說
一個為基礎格式...
在麻煩各位大大了...

vba測試.rar (47.26 KB)


不過....如果能簡化的話 能直接PO 程式碼嗎???

TOP

首先聲明,小學生一樣可以上傳檔案,並無權限問題

程式的編寫重規則的釐清,要依欄名判斷來設置攔寬,那就要知道欄名的規則舉例來說
每個工作表都有姓名欄位,但姓名欄位所在位置皆不同
如sheet1是A欄,sheet2是c欄,sheet3是g欄
那在工作表做迴圈檢查欄位時
for each sh in sheets
   set a=sh.rows(1).find("姓名")  '在標題列找尋標題
   if not a is nothing then a.ColumnWidth =30  '如果標題存在就設定欄寬
next
學海無涯_不恥下問

TOP

本帖最後由 mark15jill 於 2011-4-22 12:45 編輯

我的權限不足 所以只能擷取些程式碼出來...
目前試著用迴圈方式 對其相同處作處理(如 相同格式的欄位)
至於差異處 還是得個別設定(如 格式不同的欄位)...
目前處理的構想方向大概為
用        For Each s In Sheets   If s.Name = "" then 判斷該活頁簿是否存在...
再用      For i =   去做相同處的處理
只是針對欄位個別寬度 還是得區分...
不好意思 我的 VBA程式編寫能力 還在學習

TOP

回復 3# mark15jill


    是否請樓主把檔案(或範本)上傳~ 這樣版大大們比較快速幫你解答~
    給您建議該如何處理比較好~
學習才能提升自己

TOP

本帖最後由 mark15jill 於 2011-4-22 10:23 編輯

chin15大大
關於您貼的那個連結文章 我有看過
只是 那篇似乎無法隨著標題欄名稱更動該欄寬...
例如
        Columns("a:a").Select
        Selection.ColumnWidth = 14
        Columns("b:b").Select
        Selection.ColumnWidth = 30
這兩欄位來說
雖然 sheet1 和sheet2 都是一樣
但是
        Columns("x:x").Select
        Selection.ColumnWidth = 14
        Columns("y:y").Select
        Selection.ColumnWidth = 50
後面這幾欄位 卻會因為活頁簿不同而有所新增或減少
故 如果用那篇文章的方式來編寫的話 很容易會產生格式錯亂的問題...
因為有試驗過 所以才會詢問該問題 不好意思
以下再貼差異區域

        Columns("h:h").Select
        Selection.ColumnWidth = 50
        Columns("i:i").Select
        Selection.ColumnWidth = 20
        Columns("j:j").Select
        Selection.ColumnWidth = 60
就與發文的兩段程式碼格式 有所差異

TOP

        靜思自在 : 【時間如鑽石】時間對一個有智慧的人而言,就如鑽石般珍貴;但對愚人來說,卻像是一把泥土,一點價值也沒有。
返回列表 上一主題