返回列表 上一主題 發帖

[發問] 如何使用巨集新增一筆資料?

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
1# 跳轉到 »
發表於 2011-9-29 21:53 | 顯示全部帖子
回復 1# yeh199200
你試看看這是不是你要的 :
  1. Sub nn()
  2.   Dim lCurRows As Long, lJ As Long
  3.   Dim rData As Range
  4.   
  5.   Set rData = Sheets("數據").Cells(1, 1)
  6.   
  7.   With rData
  8.     For lJ = 4 To 17
  9.       If .Cells(lJ, 1) <> "" And .Cells(lJ, 3) <> "" Then
  10.         With Sheets(CStr(.Cells(lJ, 1)))
  11.           lCurRows = .Cells(Rows.Count, 1).End(xlUp).Row
  12.           .Cells(lCurRows, 1).Resize(1, 10).Copy
  13.           .Cells(lCurRows + 1, 1).PasteSpecial
  14.           .Cells(lCurRows + 1, 1) = Date ' 今天日期
  15.    
  16.           rData.Parent.Cells(lJ, 3).Resize(1, 4).Copy
  17.           .Cells(lCurRows + 1, 2).PasteSpecial Paste:=xlPasteValues
  18.         End With
  19.       End If
  20.     Next lJ
  21.   End With
  22. End Sub
複製代碼

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
2#
發表於 2011-9-30 22:58 | 顯示全部帖子
回復 3# yeh199200
  1. Sub auadd()
  2.   Dim lCurRows As Long ' 列號最多 65535(或 65536) 整數放不下(-32,768 到 32,767), 所以用長整數
  3.   
  4.   With Sheets("澳洲") ' 以下的 . 等同 Sheets("澳洲") 直到最底下的一個 End With
  5.     lCurRows = .Cells(Rows.Count, 1).End(xlUp).Row ' 找到最底列 (底下註解中以 甲 代表最底列號, 例如 : 第 甲 <551> 列)
  6.     .Rows(lCurRows).Copy ' Copy 甲 整列
  7.     lCurRows = lCurRows + 1 ' 甲 = 甲 + 1, 即跳到下一列準備處理
  8.     With .Cells(lCurRows, 1) ' 以下的 . 等同 A甲(A552) 儲存格
  9.       .PasteSpecial ' 貼上整列
  10.       .Value = Date ' 甲 列 A 欄內容設為今天
  11.       Sheets("數據").Cells(4, 3).Resize(1, 5).Copy ' Copy 澳洲 資料列中那 5 格的資料
  12.       With .Offset(0, 1) ' 底下的 . 等同 A甲 儲存格右移一格 (即 B甲) 儲存格
  13.         .PasteSpecial ' 貼上之前 Copy 的 5 格資料
  14.         .Resize(1, 5).Interior.ColorIndex = xlNone ' 清除之前貼上的那些儲存格的底色
  15.       End With
  16.       .Select ' 焦點移到 A甲 位置上 (即存放 今天日期 的儲存格)
  17.     End With
  18.   End With
  19. End Sub
複製代碼

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
3#
發表於 2011-10-1 09:45 | 顯示全部帖子
本帖最後由 luhpro 於 2011-10-1 09:47 編輯
ya 謝謝您
不過我想要B533填入的是"=數據!C4",C533填入的是"=數據!D4",E533填入的是"=數據!E4",F533填入的是"=數據!F4"
yeh199200 發表於 2011-10-1 08:23

看不懂你的意思呢.
需要釐清的一些事項 :
1. 是否每天都有新資料, 新資料是否都是要在每一個 Sheet 的最底端新增一列存放? 還是每次都放在固定列 (列號 533 不是 553) 上?
2. 是否是要將 Sheets("數據") 的某列中 C 欄 到 F 欄 資料放到 新增那列的 B 欄 到 E 欄?
3. 是否沒資料就不新增一列, 或是照樣要新增一列沒資料的?
因為你原先的例子是範圍儲存格複製後貼上, ( B ~ E)
但上一篇卻變成間隔放置. (B~C, E~F)

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
0  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2025-7-5 
4#
發表於 2011-10-1 16:29 | 顯示全部帖子
回復 7# yeh199200
看起來你的意思似乎是要新增公式.
這樣只要將上述程式中第 11 ~ 15 行改成 :
      For iI = 1 To 4
        .Offset(0, iI).FormulaLocal = "=數據!" & Chr(66 + iI) & "4"
      Next iI
即可.

但是因為儲存格內若用公式其值是會隨著原始資料而變更,
也就是不管你新增多少個儲存格出來,
所有儲存格中只要公式相同的其值都會是完全相同的喔:



這真是你要的結果嗎?

TOP

        靜思自在 : 得理要饒人，理直要氣和。
返回列表 上一主題