小俠客

回復 20# lpk187


    有呀，我以為是這樣：由於無法重設該工作表的USEDRANGE，所以每次在USEDRANGE中間insert了10欄，usedrange都會變大10欄
你可以試試用我的V2，最初的USEDRANGE是「$A$1:$S$31」，然後全選再全部清除資料，USEDRANGE變成「$C$1:$S$1」，所以每次程式INSERT COLUMNS，都會令USEDRANGE變大。而如果把insert那句刪去，程式便會把所有資料寫在B至D欄上，USEDRANGE便沒有變大
不知道是不是這樣，我是這樣解釋。

lpk187

回復 21# 小俠客

有時候，試驗一下就知道，下面你試一下就知道不會增加！

1. Set LayoutRS = ConfigCN.Execute(LayoutSQL)
   
2.     B = 2
   
3.     C = 3
   
4.     D = 4
   
5.    
   
6. For i = StartYear To EndYear
   
7.     'Out.Columns("B:D").Insert
   
8.     Out.Range(Columns(C), Columns(D)).Columns.Group
   
9.     Out.Cells(1, B) = i & " / FY"
   
10.     Out.Cells(1, C) = i & " / 2H"
    
11.     Out.Cells(1, D) = i & " / 1H"
    
12.    
    
13.     With LayoutRS
    
14.         .MoveFirst
    
15.         
    
16.         Do Until .EOF
    
17.             If Out.Cells(.Fields("Item_ID"), 1) = "" Then
    
18.                 Out.Cells(.Fields("Item_ID"), 1) = .Fields("Item_Name").Value
    
19.                 'End If
    
20.             End If
    
21.             .MoveNext
    
22.         Loop
    
23.     End With
    
24.    
    
25. 
    
26.     DataSQL = "select * from tbl_Income_Sub where Code = " & Code & " and S_Year = '" & i & "'"
    
27.     Set DataRS = DataCN.Execute(DataSQL)
    
28.     With DataRS
    
29.     Do Until .EOF
    
30.         Select Case .Fields("Term")
    
31.             Case "1H"
    
32.                 TargetCol = D
    
33.             Case "FY"
    
34.                 TargetCol = B
    
35.         End Select
    
36.         Out.Cells(2, TargetCol) = .Fields("Currency")
    
37.         Out.Cells(3, TargetCol) = .Fields("Unit")
    
38.         Out.Cells(4, TargetCol) = .Fields("Report_Date")
    
39.         CurrUnit = .Fields("Unit")
    
40.         If TargetCol = B Then
    
41.             Out.Cells(2, TargetCol + 1) = .Fields("Currency")
    
42.             Out.Cells(3, TargetCol + 1) = .Fields("Unit")
    
43.             Out.Cells(4, TargetCol + 1) = .Fields("Report_Date")
    
44.         End If
    
45.         .MoveNext
    
46.     Loop
    
47.     End With
    
48.    
    
49.     DataSQL = "select * from tbl_Income where Code = " & Code & " and S_Year = '" & i & "'"
    
50.     Set DataRS = DataCN.Execute(DataSQL)
    
51.    
    
52.     With DataRS
    
53.     Do Until .EOF
    
54.         If Not Out.Columns(1).Find(.Fields("Item"), lookat:=xlWhole) Is Nothing Then
    
55.             TargetRow = Out.Columns(1).Find(.Fields("Item"), lookat:=xlWhole).Row
    
56.             Select Case .Fields("Term")
    
57.                 Case "1H"
    
58.                     TargetCol = D
    
59.                 Case "FY"
    
60.                     TargetCol = B
    
61.             End Select
    
62. 
    
63.             Out.Cells(TargetRow, TargetCol) = Round(.Fields("Amount"), 4)
    
64.         End If
    
65.         .MoveNext
    
66.     Loop
    
67.     End With
    
68.     B = B + 3
    
69.     C = C + 3
    
70.     D = D + 3
    
71. 
    
72. Next i

複製代碼

stillfish00

回復 22# lpk187
重點不是這個吧 ...
現在是在說明明沒資料沒格式的儲存格，usedrange 在某些情況會誤判為有使用。

小俠客

回復 22# lpk187


謝謝你的指教，的確如此，雖然這個做法是可以令USEDRANGE不變大，但USEDRANGE的資料仍然不正確
如果執行了你提供的代碼後，手動把所有的資料刪除，USEDRANGE仍然顯示：$C$1:$T$1

lpk187

回復 24# 小俠客


    不好意思！原來我沒看前面的討論，真抱歉！
我試了不少方法，最後有發現，在結束活頁簿之前清空工作表。再打開的時候，就會恢復歸零的UsedRange。你可以試試看！

Scott090

回復 24# 小俠客


    看看下列程式能不能適合使用

1. Sub CompactSheet()
   
2.     Dim ws As Worksheet
   
3.     Dim R%, C%
   
4.     Set ws = Sheets("Output")
   
5.     With ws
   
6.         ws.[A1].Select
   
7.         Debug.Print .UsedRange.Address
   
8.         On Error Resume Next
   
9.         .Cells.Ungroup
   
10.         .Cells.EntireColumn.Hidden = False
    
11.         .Cells.Delete
    
12.         
    
13. 'Copy 一區沒有隱藏過的 Columns 到 .UsedRange
    
14. 
    
15.         [A1].Select
    
16.         Debug.Print .UsedRange.Address
    
17.         C = .UsedRange.Columns.Count
    
18.         Range("A1").Resize(.Rows.Count, C).Copy .UsedRange
    
19.         [A1].Select
    
20.         Debug.Print .UsedRange.Address
    
21.         On Error GoTo 0
    
22.     End With
    
23. End Sub

複製代碼

小俠客

回復 26# Scott090

謝謝你，我把你的代碼複製一次，當成RESET USEDRANGE.ADDRESS，但可惜未能成功。
可能是excel的BUG，無法解決...

Scott090

回復 27# 小俠客


    這個用 13# 的附件試過

1. Sub CompactSheet()
   
2.     Dim ws As Worksheet
   
3.     Dim C%, Col%
   
4.     Set ws = Sheets("Output")
   
5.     ws.Select
   
6.     With ws
   
7. '        .[A1].Select
   
8.         Debug.Print .UsedRange.Address
   
9.         On Error Resume Next
   
10. '        .Cells.Ungroup
    
11. '        .Cells.EntireColumn.Hidden = False
    
12.         If ActiveWindow.FreezePanes Then ActiveWindow.FreezePanes = False
    
13.         
    
14. '        Columns("A:Z").Delete Shift:=xlToLeft
    
15.          Col = .UsedRange.Column
    
16.         C = .UsedRange.Columns.Count
    
17.         .Cells(1, Col).Resize(.Rows.Count, C).Delete Shift:=xlToLeft
    
18.          .[A1].Select
    
19.         Debug.Print .UsedRange.Address
    
20.               
    
21.         On Error GoTo 0
    
22.     End With
    
23. End Sub

複製代碼