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

handsometrowa

各位前輩，最近抓交易資料遇到一個問題  如附件檔案 20200406選擇權十大特定人.rar (35.26 KB)

範例
下載次數: 14

2020-4-7 12:48

我希望把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

回復 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資料複製於下方資料,公式不就自動帶入了嗎??不知為何要再放入公式

handsometrowa

回復 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

n7822123

回復 3# handsometrowa


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

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

複製代碼