註冊
登錄
首頁
論壇版規
禁止列表
說明
地圖
數位書香
私人消息 (0)
公共消息 (0)
論壇任務 (0)
系統消息 (0)
好友消息 (0)
帖子消息 (0)
麻辣家族討論版版
»
Excel程式區
» 如何用VBA 把SUBOROUTINE寫入特定WORKSHEET?
1
2
3
返回列表
下一主題
上一主題
發帖
[發問]
如何用VBA 把SUBOROUTINE寫入特定WORKSHEET?
小俠客
發短消息
加為好友
小俠客
當前離線
UID
2870
帖子
83
主題
17
精華
0
積分
105
金錢
105
點名
0
作業系統
XP
軟體版本
XP
閱讀權限
20
在線時間
48 小時
註冊時間
2010-12-28
最後登錄
2018-8-8
中學生
帖子
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
發短消息
加為好友
lpk187
當前離線
UID
20047
帖子
552
主題
3
精華
0
積分
578
金錢
578
點名
0
作業系統
win7
軟體版本
office 2010
閱讀權限
50
性別
男
在線時間
892 小時
註冊時間
2015-2-8
最後登錄
2024-7-9
高中生
帖子
552
主題
3
精華
0
積分
578
點名
0
作業系統
win7
軟體版本
office 2010
閱讀權限
50
性別
男
註冊時間
2015-2-8
最後登錄
2024-7-9
22
#
發表於 2015-10-13 16:07
|
只看該作者
本帖最後由 lpk187 於 2015-10-13 16:08 編輯
回復
21#
小俠客
有時候,試驗一下就知道,下面你試一下就知道不會增加!
Set LayoutRS = ConfigCN.Execute(LayoutSQL)
B = 2
C = 3
D = 4
For i = StartYear To EndYear
'Out.Columns("B:D").Insert
Out.Range(Columns(C), Columns(D)).Columns.Group
Out.Cells(1, B) = i & " / FY"
Out.Cells(1, C) = i & " / 2H"
Out.Cells(1, D) = i & " / 1H"
With LayoutRS
.MoveFirst
Do Until .EOF
If Out.Cells(.Fields("Item_ID"), 1) = "" Then
Out.Cells(.Fields("Item_ID"), 1) = .Fields("Item_Name").Value
'End If
End If
.MoveNext
Loop
End With
DataSQL = "select * from tbl_Income_Sub where Code = " & Code & " and S_Year = '" & i & "'"
Set DataRS = DataCN.Execute(DataSQL)
With DataRS
Do Until .EOF
Select Case .Fields("Term")
Case "1H"
TargetCol = D
Case "FY"
TargetCol = B
End Select
Out.Cells(2, TargetCol) = .Fields("Currency")
Out.Cells(3, TargetCol) = .Fields("Unit")
Out.Cells(4, TargetCol) = .Fields("Report_Date")
CurrUnit = .Fields("Unit")
If TargetCol = B Then
Out.Cells(2, TargetCol + 1) = .Fields("Currency")
Out.Cells(3, TargetCol + 1) = .Fields("Unit")
Out.Cells(4, TargetCol + 1) = .Fields("Report_Date")
End If
.MoveNext
Loop
End With
DataSQL = "select * from tbl_Income where Code = " & Code & " and S_Year = '" & i & "'"
Set DataRS = DataCN.Execute(DataSQL)
With DataRS
Do Until .EOF
If Not Out.Columns(1).Find(.Fields("Item"), lookat:=xlWhole) Is Nothing Then
TargetRow = Out.Columns(1).Find(.Fields("Item"), lookat:=xlWhole).Row
Select Case .Fields("Term")
Case "1H"
TargetCol = D
Case "FY"
TargetCol = B
End Select
Out.Cells(TargetRow, TargetCol) = Round(.Fields("Amount"), 4)
End If
.MoveNext
Loop
End With
B = B + 3
C = C + 3
D = D + 3
Next i
複製代碼
TOP
stillfish00
發短消息
加為好友
stillfish00
當前離線
UID
9276
帖子
1018
主題
15
精華
0
積分
1058
金錢
1058
點名
0
作業系統
win7 32bit
軟體版本
Office 2016 64-bit
閱讀權限
50
性別
男
來自
桃園
在線時間
1141 小時
註冊時間
2012-5-9
最後登錄
2022-9-28
大學生
帖子
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
小俠客
發短消息
加為好友
小俠客
當前離線
UID
2870
帖子
83
主題
17
精華
0
積分
105
金錢
105
點名
0
作業系統
XP
軟體版本
XP
閱讀權限
20
在線時間
48 小時
註冊時間
2010-12-28
最後登錄
2018-8-8
中學生
帖子
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
發短消息
加為好友
lpk187
當前離線
UID
20047
帖子
552
主題
3
精華
0
積分
578
金錢
578
點名
0
作業系統
win7
軟體版本
office 2010
閱讀權限
50
性別
男
在線時間
892 小時
註冊時間
2015-2-8
最後登錄
2024-7-9
高中生
帖子
552
主題
3
精華
0
積分
578
點名
0
作業系統
win7
軟體版本
office 2010
閱讀權限
50
性別
男
註冊時間
2015-2-8
最後登錄
2024-7-9
25
#
發表於 2015-10-14 11:23
|
只看該作者
回復
24#
小俠客
不好意思!原來我沒看前面的討論,真抱歉!
我試了不少方法,最後有發現,在結束活頁簿之前清空工作表。再打開的時候,就會恢復歸零的UsedRange。你可以試試看!
TOP
Scott090
發短消息
加為好友
Scott090
當前離線
UID
13127
帖子
529
主題
56
精華
0
積分
607
金錢
607
點名
132
作業系統
win 10
軟體版本
[]
閱讀權限
50
性別
男
在線時間
816 小時
註冊時間
2013-3-19
最後登錄
2025-6-5
高中生
帖子
529
主題
56
精華
0
積分
607
點名
132
作業系統
win 10
軟體版本
[]
閱讀權限
50
性別
男
註冊時間
2013-3-19
最後登錄
2025-6-5
26
#
發表於 2015-11-1 16:21
|
只看該作者
回復
24#
小俠客
看看下列程式能不能適合使用
Sub CompactSheet()
Dim ws As Worksheet
Dim R%, C%
Set ws = Sheets("Output")
With ws
ws.[A1].Select
Debug.Print .UsedRange.Address
On Error Resume Next
.Cells.Ungroup
.Cells.EntireColumn.Hidden = False
.Cells.Delete
'Copy 一區沒有隱藏過的 Columns 到 .UsedRange
[A1].Select
Debug.Print .UsedRange.Address
C = .UsedRange.Columns.Count
Range("A1").Resize(.Rows.Count, C).Copy .UsedRange
[A1].Select
Debug.Print .UsedRange.Address
On Error GoTo 0
End With
End Sub
複製代碼
TOP
小俠客
發短消息
加為好友
小俠客
當前離線
UID
2870
帖子
83
主題
17
精華
0
積分
105
金錢
105
點名
0
作業系統
XP
軟體版本
XP
閱讀權限
20
在線時間
48 小時
註冊時間
2010-12-28
最後登錄
2018-8-8
中學生
帖子
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
發短消息
加為好友
Scott090
當前離線
UID
13127
帖子
529
主題
56
精華
0
積分
607
金錢
607
點名
132
作業系統
win 10
軟體版本
[]
閱讀權限
50
性別
男
在線時間
816 小時
註冊時間
2013-3-19
最後登錄
2025-6-5
高中生
帖子
529
主題
56
精華
0
積分
607
點名
132
作業系統
win 10
軟體版本
[]
閱讀權限
50
性別
男
註冊時間
2013-3-19
最後登錄
2025-6-5
28
#
發表於 2015-11-4 23:53
|
只看該作者
回復
27#
小俠客
這個用 13# 的附件試過
Sub CompactSheet()
Dim ws As Worksheet
Dim C%, Col%
Set ws = Sheets("Output")
ws.Select
With ws
' .[A1].Select
Debug.Print .UsedRange.Address
On Error Resume Next
' .Cells.Ungroup
' .Cells.EntireColumn.Hidden = False
If ActiveWindow.FreezePanes Then ActiveWindow.FreezePanes = False
' Columns("A:Z").Delete Shift:=xlToLeft
Col = .UsedRange.Column
C = .UsedRange.Columns.Count
.Cells(1, Col).Resize(.Rows.Count, C).Delete Shift:=xlToLeft
.[A1].Select
Debug.Print .UsedRange.Address
On Error GoTo 0
End With
End Sub
複製代碼
TOP
靜思自在 :
【生命在呼吸間】佛陀說:「生命在呼吸間。」人無法管住自己的生命,更無法擋住死期,讓自己永住人間。既然生命去來這麼無常,我們更應該好好地愛惜它、利用它、充實它,讓這無常、寶貴的生命,散發它真善美的光輝,映照出生命真正的價值。
1
2
3
返回列表
下一主題
上一主題
EXCEL專屬討論區
Excelㄧ般區
Excel程式區
進階應用專區
OFFICE 系列
Word
PowerPoint
Access
Office不分區
程式語言
VB 與 VB.Net
C 與 C#
Java 與 J#
程式設計不分區
資料庫
ORACLE
My SQL
MS SQL
網頁設計
ASP 與 ASP.NET
PHP
PHP+MySQL 入門實作
JavaScript
FLASH / ActionScript
HTM/ HTML/ CSS
網頁設計不分區
電腦與作業系統
電腦各種硬體討論
一般電腦軟體討論
論壇事務
管理公告
投訴反映
新手測試
愛 ‧ 生活
公益佈告欄
生活與感動
[收藏此主題]
[關注此主題的新回復]
[通過 QQ、MSN 分享給朋友]
申請友情鏈接
Facebook粉絲