Board logo

標題: 跨工作表自動隱藏空白列問題 [打印本頁]

作者: msmplay    時間: 2016-4-2 22:33     標題: 跨工作表自動隱藏空白列問題

不好意思,想請教一下大師們2個程式碼的問題~~~

問題一
以下是針對單一活頁,自動隱藏列5:列25空白列的程式碼
想請問如果想在活頁1:31一次同時執行的話,該如何修改呢?
另外想再請教是否有一次隱藏空白列的寫法,而非一列一列隱藏呢?

Sub Macro1()
For i = 5 To 25
If Cells(i, 3) = "" Then
    Rows(i).EntireRow.Hidden = True
Else
    Rows(i).EntireRow.Hidden = False
End If
Next
End Sub

問題二
以下是固定排序1:31活頁,"C6:AI14"資料的程式碼(感謝 stillfish00 大師幫忙)
請問該如何將這兩個程式碼結合寫在一起呢?
希望執行條件為:排序後隱藏空白列

Sub Test()
    Dim i As Integer
    For i = 1 To 31
        With Sheets(CStr(i))
            .Sort.SortFields.Clear
            .Sort.SortFields.Add key:=.Range("D6"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With .Sort
                .SetRange Range("C6:AI14")
                .Header = xlGuess
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        End With
    Next
End Sub

以上還請各位大師們不吝指教~~~~~~非常感謝唷~~~~~~
作者: luhpro    時間: 2016-4-3 00:27

本帖最後由 luhpro 於 2016-4-3 00:31 編輯
不好意思,想請教一下大師們2個程式碼的問題~~~

問題一
以下是針對單一活頁,自動隱藏列5:列25空白列的 ...
msmplay 發表於 2016-4-2 22:33

For i = 1 To 31
  Sheets(i).Rows("5:25").EntireRow.Hidden =true
Next

問題二

把底下這行插在最後一個 End With 前 :

Sheets(i).Rows("5:25").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden =true
作者: msmplay    時間: 2016-4-3 11:54

本帖最後由 msmplay 於 2016-4-3 11:56 編輯

回復 2# luhpro

l大~~~~非常感謝您的熱心幫忙,但小妹遇到幾個問題,是我沒說明清楚真的非常抱歉~~~~~~~
就是問題一的1:31活頁、列5:列25,還必須是第3欄為空白格才需隱藏。因為測試了一下,發現列5:列25居然全隱藏了
For i = 5 To 25
If Cells(i, 3) = "" Then

然後問題二,我把l大的程式碼插入後最後一個 End With 前(如下),但它卻連別的活頁也跟著被影響了。
最下圖是檔案的活頁,原只需排序跟隱藏1:31活頁,但修改後連月總表、週時表也跟著被隱藏了,請問是否可再幫幫小妹呢!!非常感謝~~~~~~~~
Sub Test()
    Dim i As Integer
    For i = 1 To 31
        With Sheets(CStr(i))
            .Sort.SortFields.Clear
            .Sort.SortFields.Add key:=.Range("D6"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With .Sort
                .SetRange Range("C6:AI14")
                .Header = xlGuess
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
Sheets(i).Rows("5:25").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden =true
        End With
    Next
End Sub

[attach]23691[/attach]

作者: msmplay    時間: 2016-4-4 22:03

小妹已補上測試檔,並於檔案內再次說明原始的問題,不知道~~~~~~是否可再麻煩大師們協助幫忙看看呢!!

[attach]23724[/attach]
作者: 准提部林    時間: 2016-4-4 23:32

回復 3# msmplay


Sheets(i).Rows("5:25").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden =true

i 未轉為[文字]型態, 是以 INDEX 處理工作表, 而不是工作表[名稱],
最簡單方法:
Sheets(i & "").Rows("5:25").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden =true

用原來的 CSTR( i)  也可!!!
作者: msmplay    時間: 2016-4-5 00:19

回復 5# 准提部林

准大~~~你是說改成以下醬嗎?一定不是對不對!!因為小妹試完變成以下醬~~可以再救救小妹我嗎~~~~

Sub Test()
    Dim i As Integer
    For i = 1 To 31
        With Sheets(CStr(i))
            .Sort.SortFields.Clear
            .Sort.SortFields.Add key:=.Range("D6"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With .Sort
                .SetRange Range("C6:AI14")
                .Header = xlGuess
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
Sheets(i & "").Rows("5:25").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden =true
        End With
    Next
End Sub

(反黃是要隱藏的列)
[attach]23726[/attach][attach]23727[/attach]
作者: msmplay    時間: 2016-4-5 00:41

回復 5# 准提部林

抱歉,再補充一下,因為每個活頁的C欄姓名,空白的列位有可能都不一樣,所以不是要固定隱藏哪幾列的意思喔!!怕又造成大家誤會了~~~~
作者: 准提部林    時間: 2016-4-5 09:56

  1. Sub 排序班別()
  2. Dim i As Integer
  3. For i = 1 To 31
  4.     With Sheets(i & "")
  5.         '排序
  6.         .[C5:AI16].Sort Key1:=.[D5], Order1:=xlAscending, Header:=xlNo, _
  7.                   OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  8.                   
  9.         '隱藏
  10.         On Error Resume Next '略過沒有空白格的錯誤
  11.         .[C5:C16].SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
  12.         On Error GoTo 0
  13.     End With
  14. Next i
  15. End Sub
複製代碼

作者: msmplay    時間: 2016-4-5 13:20

本帖最後由 msmplay 於 2016-4-5 13:23 編輯

回復 8# 准提部林

准大~~~~超級感謝您熱心幫忙ㄉ
不過小妹好像又遇到另一個問題,就是公司檔案內的C5 : D16空白儲存格,其實是以IF公式判斷是否為空格或帶值,但發現好像醬就沒辦法排序跟隱藏了。

可以再請教一下准大該如何修改嗎?真的是麻煩您了~~~~
作者: 准提部林    時間: 2016-4-5 16:36

本帖最後由 准提部林 於 2016-4-5 16:40 編輯

回復 9# msmplay

C欄有公式,不動它,利用AJ欄為輔助(注意:AJ欄不可為文字格式,須為〔通用格式〕) 

Sub 排序班別()
Dim i As Integer
Application.Calculation = xlCalculationManual '關閉自動重算, 加快速度
For i = 1 To 31
  With Sheets(i & "")
     .[AJ5:AJ16] = .[D5:D16].Value '將D欄公式值暫貼至AJ欄
  
     '排序(改以AJ欄為主)
     .[C5:AJ16].Sort Key1:=.[AJ5], Order1:=xlAscending, _
          Header:=xlNo, OrderCustom:=1, _
          MatchCase:=False, Orientation:=xlTopToBottom
  
     .[AJ5:AJ16] = .[C5:C16].Value '將C欄公式值暫貼至AJ欄
     On Error Resume Next '略過沒有空白格的錯誤
     .[AJ5:AJ16].SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True '隱藏
     On Error GoTo 0
  
     .[AJ5:AJ16].ClearContents '清除AJ欄
    End With
Next i
Application.Calculation = xlCalculationAutomatic '恢復自動重算
End Sub
作者: msmplay    時間: 2016-4-5 17:52

回復 10# 准提部林

准大~~~~~~~~~謝謝你、謝謝你、謝謝你!!
因為很重要所以要說三次!!




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)