返回列表 上一主題 發帖

[發問] 如何用VBA 把SUBOROUTINE寫入特定WORKSHEET?

回復 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便沒有變大
不知道是不是這樣,我是這樣解釋。

TOP

本帖最後由 lpk187 於 2015-10-13 16:08 編輯

回復 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.     DataSQL = "select * from tbl_Income_Sub where Code = " & Code & " and S_Year = '" & i & "'"
  26.     Set DataRS = DataCN.Execute(DataSQL)
  27.     With DataRS
  28.     Do Until .EOF
  29.         Select Case .Fields("Term")
  30.             Case "1H"
  31.                 TargetCol = D
  32.             Case "FY"
  33.                 TargetCol = B
  34.         End Select
  35.         Out.Cells(2, TargetCol) = .Fields("Currency")
  36.         Out.Cells(3, TargetCol) = .Fields("Unit")
  37.         Out.Cells(4, TargetCol) = .Fields("Report_Date")
  38.         CurrUnit = .Fields("Unit")
  39.         If TargetCol = B Then
  40.             Out.Cells(2, TargetCol + 1) = .Fields("Currency")
  41.             Out.Cells(3, TargetCol + 1) = .Fields("Unit")
  42.             Out.Cells(4, TargetCol + 1) = .Fields("Report_Date")
  43.         End If
  44.         .MoveNext
  45.     Loop
  46.     End With
  47.    
  48.     DataSQL = "select * from tbl_Income where Code = " & Code & " and S_Year = '" & i & "'"
  49.     Set DataRS = DataCN.Execute(DataSQL)
  50.    
  51.     With DataRS
  52.     Do Until .EOF
  53.         If Not Out.Columns(1).Find(.Fields("Item"), lookat:=xlWhole) Is Nothing Then
  54.             TargetRow = Out.Columns(1).Find(.Fields("Item"), lookat:=xlWhole).Row
  55.             Select Case .Fields("Term")
  56.                 Case "1H"
  57.                     TargetCol = D
  58.                 Case "FY"
  59.                     TargetCol = B
  60.             End Select

  61.             Out.Cells(TargetRow, TargetCol) = Round(.Fields("Amount"), 4)
  62.         End If
  63.         .MoveNext
  64.     Loop
  65.     End With
  66.     B = B + 3
  67.     C = C + 3
  68.     D = D + 3

  69. Next i
複製代碼

TOP

回復 22# lpk187
重點不是這個吧 ...
現在是在說明明沒資料沒格式的儲存格,usedrange 在某些情況會誤判為有使用。
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

回復 22# lpk187


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

TOP

回復 24# 小俠客


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

TOP

回復 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.         [A1].Select
  15.         Debug.Print .UsedRange.Address
  16.         C = .UsedRange.Columns.Count
  17.         Range("A1").Resize(.Rows.Count, C).Copy .UsedRange
  18.         [A1].Select
  19.         Debug.Print .UsedRange.Address
  20.         On Error GoTo 0
  21.     End With
  22. End Sub
複製代碼

TOP

回復 26# Scott090

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

TOP

回復 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
複製代碼

TOP

        靜思自在 : 【生命在呼吸間】佛陀說:「生命在呼吸間。」人無法管住自己的生命,更無法擋住死期,讓自己永住人間。既然生命去來這麼無常,我們更應該好好地愛惜它、利用它、充實它,讓這無常、寶貴的生命,散發它真善美的光輝,映照出生命真正的價值。
返回列表 上一主題