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

帖子: 824
主題: 6
精華: 0
積分: 904
點名: 0
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2023-12-24

2^#

發表於 2011-9-29 21:53 | 只看該作者

回復 1# yeh199200
你試看看這是不是你要的 :

Sub nn()
Dim lCurRows As Long, lJ As Long
Dim rData As Range
Set rData = Sheets("數據").Cells(1, 1)
With rData
For lJ = 4 To 17
If .Cells(lJ, 1) <> "" And .Cells(lJ, 3) <> "" Then
With Sheets(CStr(.Cells(lJ, 1)))
lCurRows = .Cells(Rows.Count, 1).End(xlUp).Row
.Cells(lCurRows, 1).Resize(1, 10).Copy
.Cells(lCurRows + 1, 1).PasteSpecial
.Cells(lCurRows + 1, 1) = Date ' 今天日期
rData.Parent.Cells(lJ, 3).Resize(1, 4).Copy
.Cells(lCurRows + 1, 2).PasteSpecial Paste:=xlPasteValues
End With
End If
Next lJ
End With
End Sub

複製代碼

帖子: 17
主題: 3
精華: 0
積分: 20
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 10
性別: 男
註冊時間: 2011-5-4
最後登錄: 2012-9-15

3^#

發表於 2011-9-30 10:03 | 只看該作者

回復 2# luhpro

謝謝回覆不過好像有點怪怪的.
我想的是要單一國家(澳洲)就好,因為不是每天都會有交易.您寫的是亞洲都加入.
這是我錄製的澳洲新增的巨集
Sub auadd()
Rows("551:551").Select
Selection.Copy
Range("A552").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("B552").Select
ActiveCell.FormulaR1C1 = "=數據!R4C[1]"
Range("B552").Select
Selection.Copy
Range("C552:E552").Select
ActiveSheet.Paste
End Sub
可否修改此巨集謝謝

帖子: 824
主題: 6
精華: 0
積分: 904
點名: 0
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2023-12-24

4^#

發表於 2011-9-30 22:58 | 只看該作者

回復 3# yeh199200

Sub auadd()
Dim lCurRows As Long ' 列號最多 65535(或 65536) 整數放不下(-32,768 到 32,767), 所以用長整數
With Sheets("澳洲") ' 以下的 . 等同 Sheets("澳洲") 直到最底下的一個 End With
lCurRows = .Cells(Rows.Count, 1).End(xlUp).Row ' 找到最底列 (底下註解中以甲代表最底列號, 例如 : 第甲 <551> 列)
.Rows(lCurRows).Copy ' Copy 甲整列
lCurRows = lCurRows + 1 ' 甲 = 甲 + 1, 即跳到下一列準備處理
With .Cells(lCurRows, 1) ' 以下的 . 等同 A甲(A552) 儲存格
.PasteSpecial ' 貼上整列
.Value = Date ' 甲列 A 欄內容設為今天
Sheets("數據").Cells(4, 3).Resize(1, 5).Copy ' Copy 澳洲資料列中那 5 格的資料
With .Offset(0, 1) ' 底下的 . 等同 A甲儲存格右移一格 (即 B甲) 儲存格
.PasteSpecial ' 貼上之前 Copy 的 5 格資料
.Resize(1, 5).Interior.ColorIndex = xlNone ' 清除之前貼上的那些儲存格的底色
End With
.Select ' 焦點移到 A甲位置上 (即存放今天日期的儲存格)
End With
End With
End Sub

複製代碼

帖子: 17
主題: 3
精華: 0
積分: 20
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 10
性別: 男
註冊時間: 2011-5-4
最後登錄: 2012-9-15

5^#

發表於 2011-10-1 08:23 | 只看該作者

回復 yeh199200
luhpro 發表於 2011-9-30 22:58

ya 謝謝您
不過我想要B533填入的是"=數據!C4",C533填入的是"=數據!D4",E533填入的是"=數據!E4",F533填入的是"=數據!F4"
這樣當我打開sheet1 的時候就可看到全部國家的技術指標資料 .. 謝謝您

帖子: 824
主題: 6
精華: 0
積分: 904
點名: 0
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2023-12-24

6^#

發表於 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)

帖子: 17
主題: 3
精華: 0
積分: 20
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 10
性別: 男
註冊時間: 2011-5-4
最後登錄: 2012-9-15

7^#

發表於 2011-10-1 10:16 | 只看該作者

看不懂你的意思呢.
需要釐清的一些事項 :
1. 是否每天都有新資料, 新資料是否都是要在每一個 Sheet 的最 ...
luhpro 發表於 2011-10-1 09:45

不好意思小弟可能沒說清楚
1. 是否每天都有新資料, 新資料是否都是要在每一個 Sheet 的最底端新增一列存放?
對的. 只要新增到最後Sheet 的最底端新增一列存放
2. 是否是要將 Sheets("數據") 的某列中 C 欄到 F 欄資料放到新增那列的 B 欄到 E 欄?
小弟不是要填入數值,是要B533 填入 =數據!C4
                                    C533填入  =數據!D4
                                    D533填入 =數據!E4
                                    F533填入 = 數據!F4

就是這樣爾已.
3是否沒資料就不新增一列, 或是照樣要新增一列沒資料的?
只要新增到最後一列就好..

謝謝您

帖子: 824
主題: 6
精華: 0
積分: 904
點名: 0
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2023-12-24

8^#

發表於 2011-10-1 16:29 | 只看該作者

回復 7# yeh199200
看起來你的意思似乎是要新增公式.
這樣只要將上述程式中第 11 ~ 15 行改成 :
   For iI = 1 To 4
      .Offset(0, iI).FormulaLocal = "=數據!" & Chr(66 + iI) & "4"
   Next iI
即可.

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

這真是你要的結果嗎?

帖子: 17
主題: 3
精華: 0
積分: 20
點名: 0
作業系統: xp
軟體版本: office 2003
閱讀權限: 10
性別: 男
註冊時間: 2011-5-4
最後登錄: 2012-9-15

9^#

發表於 2011-10-1 17:18 | 只看該作者

回復 yeh199200
看起來你的意思似乎是要新增公式.
這樣只要將上述程式中第 11 ~ 15 行改成 :
Fo ...
luhpro 發表於 2011-10-1 16:29

謝謝您小弟就是要此結果謝謝
真的解決小弟好幾個月的問題...謝謝