關於儲存格需要公式計算，又要複製貼上，怎麼處理比較好?

各位前輩，最近抓交易資料遇到一個問題如附件檔案

20200406選擇權十大特定人.rar (35.26 KB)

我希望把A2:T2 的資料更新之後
貼到最新的資料下方按照日期排好，
可是遇到 A2:T2 裡面有些空格不是單純的資料，而是公式，
所以我不知道該怎麼讓貼過去的資料除外的公式儲存格，
也能自動去補填資料

我的方法是寫一個副程式讓他去執行例如
範例H13的資料是  =$G13 -$G12 我就呼叫一次重整換算1()

Sub 重整換算1()
Dim i As Integer
For i = 4 To Range("H4").End(xlDown).Row
Cells(i, "H") = Cells(i, "G") - Cells(i - 1, "G")
Next i
End Sub
然後如果又有一格例如J  =  $I13-$I12  我又再呼叫一次重整換算2()

Sub 重整換算2()
Dim i As Integer
For i = 4 To Range("J4").End(xlDown).Row
Cells(i, "J") = Cells(i, "I") - Cells(i - 1, "I")
Next i
End Sub

這樣下去如果需要運算的格子有30個就要寫30個副程式
迴圈是我最弱的一環，請問前輩們能否指導我應該怎麼去思考這類的問題
這就是不斷的在某些重複的過程中找到處理的手法

再者我也有想過是不是能在最後貼上的一行資料裡面
寫一個  For each myRng  去找  會回傳 iferror 的儲存格，然後讓該儲存格等於公式計算的結果??

希望大家給予指導謝謝~@@

樓主熱帖

jcchiang

中學生 Rank: 2

帖子: 234
主題: 19
精華: 0
積分: 276
點名: 0
作業系統: Windows XP
軟體版本: office 2003
閱讀權限: 20
性別: 男
註冊時間: 2013-1-7
最後登錄: 2021-10-7

2^#

發表於 2020-4-8 11:18 | 只看該作者

回復 1# handsometrowa

試試看"重整換算"
Sub ex()
Dim arr As Variant
Dim a As Variant
Dim x%
arr = Array("H", "J", "N", "P")  '放入要用公式的欄位
For Each a In arr
For x = 4 To Range(a & 65535).End(3).Row
   Cells(x, a) = "=$" & Range(a & x).Offset(0, -1).Address(0, 0) & "-$" & Range(a & (x - 1)).Offset(0, -1).Address(0, 0)  '放入公式H4=$G4-$G3,H5=$G5-$G4...以此類推
Next
Next
arr = Array("K")  '放入要用公式的欄位
For Each a In arr
For x = 4 To Range(a & 65535).End(3).Row
   Cells(x, a) = "=$" & Range(a & x).Offset(0, -3).Address(0, 0) & "-$" & Range(a & x).Offset(0, -1).Address(0, 0)  '放入公式K4=$H4-$J4,K5=$H5-$J5...以此類推
Next
Next
End Sub

將A2:T2資料複製於下方資料,公式不就自動帶入了嗎??不知為何要再放入公式

TOP

handsometrowa

中學生 Rank: 2

帖子: 82
主題: 7
精華: 0
積分: 112
點名: 0
作業系統: WIN7
軟體版本: WIN7
閱讀權限: 20
性別: 男
註冊時間: 2013-1-3
最後登錄: 2020-9-21

3^#

發表於 2020-4-10 11:50 | 只看該作者

回復 2# jcchiang

謝謝jcc前輩

您問到
『將A2:T2資料複製於下方資料,公式不就自動帶入了嗎??不知為何要再放入公式』

中間會產生一個問題，就是複製公式下來，他的相對位置不會更著改變
會造成最新的那一行資料  會產生#VALUE 參照錯誤，就算copy  公式了他不會自動位移該公式對照的位置:'(

後來我用另外一種方式cells 去找那個會產生錯誤的儲存格  類似下面這種
Dim myRng As Range, endRng As Range
      Dim i  As Integer
      Dim j  As Integer
      Dim k As Integer

Worksheets("資料更新").Activate
      Set myRng = Sheets("資料更新").Range("A2:U2")
      Set endRng = Worksheets("資料更新").Range("A1048576").End(xlUp).Offset(1, 0)
      j = endRng.Row
      k = Range("U2").Column
      myRng.Copy
      endRng.Select
      Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
      xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False
      On Error Resume Next

      For i = 1 To k
         If IsError(Cells(j, i)) Then
         Cells(j, i).Value = Cells(j, i).Offset(0, -1).Value - Cells(j, i).Offset(-1, -1).Value
         End If
      Next i

TOP

n7822123

　暱稱: 阿龍

中學生 Rank: 2

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

4^#

發表於 2020-4-11 01:12 | 只看該作者

本帖最後由 n7822123 於 2020-4-11 01:19 編輯

回復 3# handsometrowa

看了你的附件~ 你的意思是黃色儲存格的欄位要填入第2列的"值"，
其他欄位要填入第2列的"公式"，是這樣嗎?
感覺沒那麼複雜.............可是為什麼你的敘述有點複雜@@
試試吧!

Sub 貼上資料()
R% = [A65536].End(3).Row + 1
'先全部填入值~
Cells(R, 1).Resize(1, 20) = Cells(2, 1).Resize(1, 20).Value
Arr = Array(8, 10, 11, 14, 16, 18, 19, 20) '要公式的欄號
For Each c In Arr '複製第2列公式~
Cells(2, c).Copy Cells(R, c)
Next
End Sub

複製代碼

程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP