返回列表 上一主題 發帖

重複使用VBA

lamwc

帖子
2 
主題
1 
精華
0 
積分
3 
點名
0  
作業系統
WINDOW 
軟體版本
8 
閱讀權限
10 
註冊時間
2021-8-20 
最後登錄
2021-8-23 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2021-8-20 09:14 | 只看該作者

重複使用VBA

各位好，想請教一下如何使用VBA在各表的底下新增一列並下拉上列的公式，同時在公式當中設定代數以便後續再次新增使用，謝謝。

目前構想如下，剛接觸沒多久，希望有大神指教指教。



----------------------------------------------------------
Sub 巨集1()
'
' 巨集1 巨集
'

'
Dim x As Integer
Dim y As Integer
x = 18
y = 1


    ActiveWindow.SmallScroll Down:=18
    Range("x:x,x+19+1*y:x+19+1*y,x+38+2*y:x+38+2*y,x+57+3*y:x+57+3*y").Select
    Range("A75").Activate
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
   
    Range("A(x-1):E(x-1)").Select
    Range("E(x-1)").Activate
    Selection.AutoFill Destination:=Range("Ax-1:Ex"), Type:=xlFillDefault
    Range("Ax-1:Ex").Select

    Range("A(x+19+1*y-1):F(x+19+1*y-1)").Select
    Range("F(x+19+1*y-1)").Activate
    Selection.AutoFill Destination:=Range("A(x+19+1*y-1):F(x+19+1*y)"), Type:=xlFillDefault
    Range("A(x+19+1*y-1):F(x+19+1*y)").Select
   
    Range("A(x+38+2*y-1):G(x+38+2*y-1)").Select
    Range("G(x+38+2*y-1)").Activate
    Selection.AutoFill Destination:=Range("A(x+38+2*y-1):F((x+38+2*y)"), Type:=xlFillDefault
    Range("A(x+38+2*y-1):F(x+38+2*y)").Select
   
    Range("A(x+57+3*y-1):H(x+57+3*y-1)").Select
    Range("H(x+57+3*y-1)").Activate
    Selection.AutoFill Destination:=Range("A(x+57+3*y-1):H(x+57+3*y)"), Type:=xlFillDefault
    Range("A(x+57+3*y-1):(x+57+3*y)").Select


End Sub
收藏 分享

lamwc

帖子
2 
主題
1 
精華
0 
積分
3 
點名
0  
作業系統
WINDOW 
軟體版本
8 
閱讀權限
10 
註冊時間
2021-8-20 
最後登錄
2021-8-23 
2#
發表於 2021-8-20 09:26 | 只看該作者
第一行列 我應該已調整成合理的格式 但依然跑不動   

Range(x & ":" & x, x + 19 + 1 * y & ":" & x + 19 + 1 * y, x + 38 + 2 * y & ":" & x + 38 + 2 * y, x + 57 + 3 * y & ":" & x + 57 + 3 * y).Select

TOP

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2023-9-21 
3#
發表於 2021-8-21 00:10 | 只看該作者
回復 2# lamwc


可否附上檔案且加以說明，謝謝

TOP

ikboy

帖子
262 
主題
8 
精華
0 
積分
280 
點名
16  
作業系統
xp 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
HK 
註冊時間
2015-8-11 
最後登錄
2024-3-28 

2016猴年全勤獎章
4#
發表於 2021-8-22 12:35 | 只看該作者
沒有附件, 衹能猜想
  1. Selection.resize(2).Filldown
複製代碼

TOP

ML089

帖子
2025 
主題
13 
精華
0 
積分
2053 
點名
0  
作業系統
WIN7 
軟體版本
Office2007 
閱讀權限
100 
性別
男 
來自
台北市 
註冊時間
2011-3-2 
最後登錄
2024-3-14 

論壇榮譽勳章論壇贊助勳章熱烈參與勳章2014馬年全勤獎章2015羊年全勤獎章2016猴年全勤獎章
5#
發表於 2021-8-22 19:18 | 只看該作者
回復 2# lamwc

Rs = x & ":" & x & "," & x + 19 + 1 * y & ":" & x + 19 + 1 * y & "," & x + 38 + 2 * y & ":" & x + 38 + 2 * y & "," & x + 57 + 3 * y & ":" & x + 57 + 3 * y
debug.print  Rs  '  "18:18,38:38,58:58,78:78"
Range(Rs).Select

每行先印出來檢查是否有問題
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

        靜思自在 : 為人處世要小心細心，但不要「小心眼」。
返回列表 上一主題