返回列表 上一主題 發帖

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

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

各位前輩,最近抓交易資料遇到一個問題  如附件檔案 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 的儲存格,然後讓該儲存格等於公式計算的結果??

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

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

回復 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 於 2020-4-11 01:19 編輯

回復 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
複製代碼
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

        靜思自在 : 有願放在心裡,沒有身體力行,正如耕田不播種,皆是空過因緣。
返回列表 上一主題