123
返回列表 上一主題 發帖

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

小俠客

帖子
83 
主題
17 
精華
0 
積分
105 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2010-12-28 
最後登錄
2018-8-8 
21# 跳轉到 »
發表於 2015-10-13 15:41 | 只看該作者
回復 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

帖子
552 
主題
6 
精華
0 
積分
576 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2026-9-10 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
22#
發表於 2015-10-13 16:07 | 只看該作者
本帖最後由 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.    

  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

  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

  72. Next i
複製代碼

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
23#
發表於 2015-10-13 16:38 | 只看該作者
回復 22# lpk187
重點不是這個吧 ...
現在是在說明明沒資料沒格式的儲存格，usedrange 在某些情況會誤判為有使用。
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

小俠客

帖子
83 
主題
17 
精華
0 
積分
105 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2010-12-28 
最後登錄
2018-8-8 
24#
發表於 2015-10-13 16:44 | 只看該作者
回復 22# lpk187


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

TOP

lpk187

帖子
552 
主題
6 
精華
0 
積分
576 
點名
0  
作業系統
win7 
軟體版本
office 2010 
閱讀權限
50 
性別
男 
註冊時間
2015-2-8 
最後登錄
2026-9-10 

2016猴年全勤獎章2015羊年全勤獎章熱烈參與勳章
25#
發表於 2015-10-14 11:23 | 只看該作者
回復 24# 小俠客


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

TOP

Scott090

帖子
533 
主題
58 
精華
0 
積分
613 
點名
239  
作業系統
win 10 
軟體版本
[] 
閱讀權限
50 
性別
男 
註冊時間
2013-3-19 
最後登錄
2026-9-30 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章2015羊年全勤獎章熱烈參與勳章
26#
發表於 2015-11-1 16:21 | 只看該作者
回復 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

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

TOP

小俠客

帖子
83 
主題
17 
精華
0 
積分
105 
點名
0  
作業系統
XP 
軟體版本
XP 
閱讀權限
20 
註冊時間
2010-12-28 
最後登錄
2018-8-8 
27#
發表於 2015-11-3 12:23 | 只看該作者
回復 26# Scott090

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

TOP

Scott090

帖子
533 
主題
58 
精華
0 
積分
613 
點名
239  
作業系統
win 10 
軟體版本
[] 
閱讀權限
50 
性別
男 
註冊時間
2013-3-19 
最後登錄
2026-9-30 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章論壇榮譽勳章論壇贊助勳章2015羊年全勤獎章熱烈參與勳章
28#
發表於 2015-11-4 23:53 | 只看該作者
回復 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

        靜思自在 : 能付出愛心就是福，能消除煩惱就是慧。
123
返回列表 上一主題