Board logo

標題: 複製公式 [打印本頁]
作者: myleoyes    時間: 2014-1-20 21:19     標題: 複製公式

各位前輩你們好!!   
    假設A3=1,A4=2,A5=3
    Sub Ex()
        Dim Rng As Range, e As Range
        If [A3] = "" Then
           [AH1] = "=SUM(INDIRECT(""AH3:AH1200""))"
           [AH2] = "=$A3&""筆"""
        ElseIf [A3] <> "" Then
           With Sheet3
              Set Rng = .Range("AH1", .Range("ZZ1").End(xlToLeft))
              Set e = Rng(1, Rng.Columns.Count + 1)
           End With
           Set Rng = Range("AH1:AH2")
           Rng.Copy e
        End If
   End Sub
   執行結果AI1與AH1公式都相同
           AI2與AH2公式也相同
   應該如下
   當第一次按鈕
        AH1=SUM(INDIRECT("AH3:AH1200"))
        AH2=$A3&"筆"
   第二次按鈕
        AI1=SUM(INDIRECT("AI3:AI1200"))
        AI2=$A4&"筆"
   第三次按鈕
        AJ1=SUM(INDIRECT("AJ3:AJ1200"))
        AJ2=$A5&"筆"
   以此類推請問程式如何修改?
   請知道的前輩,不吝賜教謝謝再三!!
作者: GBKEE    時間: 2014-1-21 07:34

回復 1# myleoyes
是這樣嗎?
  1. Rng.Copy
  2.            e.PasteSpecial xlPasteValues   '僅有值
複製代碼
作者: myleoyes    時間: 2014-1-21 21:35

回復 2# GBKEE
良師!謝謝!!不能為值要的是公式
          範例的 AI1=SUM(INDIRECT("AI3:AI1200"))
                       AI2=$A4&"筆"
                      AJ1=SUM(INDIRECT("AJ3:AJ1200"))
                      AJ2=$A5&"筆"
           請再麻煩指導!!
          再請教另一問題與本問題是相關連的
         辛苦囉!請不吝賜教謝謝再三!!
作者: GBKEE    時間: 2014-1-22 08:49

回復 3# myleoyes

試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim C As Integer, Rng As Range
  4.     Set Rng = [Ah1]
  5.     C = Cells(1, Columns.Count).End(xlToLeft).Column
  6.     If C < Rng.Column Then
  7.         C = Rng.Column
  8.     Else
  9.         C = C + 1
  10.     End If
  11.     Cells(1, C) = "=SUM(R3C:R200C)"
  12.     Cells(2, C) = "=R" & C - Rng.Column + 2 & "C1&""筆"""
  13. End Sub
複製代碼
作者: myleoyes    時間: 2014-1-22 21:50

回復 4# GBKEE
良師!謝謝!!不知結算程式是否有解??
        請不吝賜教謝謝再三!!
作者: GBKEE    時間: 2014-1-23 11:17

回復 5# myleoyes

如圖一在102/5月登入第1筆 , 第2筆資料
月底結算按鈕AH3:AI3分別產生數據
故AH欄與AI欄的起點都從第三列開始
無可厚非AH欄的起點必定是AH3開始
然而AI欄的起點並不一定是AI3開始
範例圖一純屬巧合
為何會純屬巧合?
請上傳實際檔案說明
作者: myleoyes    時間: 2014-1-25 11:15

回復 6# GBKEE
良師!
     不好意思!因為電腦的硬碟掛了!
     換新重灌所以耽誤了時間抱歉
     小弟已附上檔案請參考看看
     只請半天假,趕上班掰掰!!
     辛苦囉!謝謝再三!!
作者: GBKEE    時間: 2014-1-25 14:32

回復 7# myleoyes
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim C As Integer, Rng(1 To 2) As Range, i As Integer, ii As Integer
  4.     Set Rng(1) = [AH1]
  5.     C = Cells(1, Columns.Count).End(xlToLeft).Column
  6.     If C < Rng(1).Column Then
  7.         C = Rng(1).Column
  8.     Else
  9.         C = C + 1
  10.     End If
  11.     Cells(1, C) = "=SUM(R3C:R200C)"
  12.     Cells(2, C) = "=R" & C - Rng(1).Column + 3 & "C1&""筆"""
  13.     ii = 3
  14.     Set Rng(2) = Cells(1200, Rng(1).Column).End(xlUp).Offset(1)
  15.     For i = 0 To C - Rng(1).Column
  16.         If Val(Cells(2, Rng(2).Column).Offset(, i)) <> 0 Then
  17.           Rng(2).Offset(, i) = "=ROUND(r" & ii & "c6 *" & [M3] & ",2)"
  18.             ii = ii + 1
  19.         End If
  20.     Next
  21. End Sub
複製代碼
作者: myleoyes    時間: 2014-1-25 21:39

回復 8# GBKEE
良師!謝謝!!
        程式錯誤1004?
        錯誤!!在此列  Rng(2).Offset(, i) = "=ROUND(R" & ii & "c6 *" & [M3] & ",2)"
       小弟能力不足無法修改請麻煩修正辛苦囉!謝謝再三!!
作者: myleoyes    時間: 2014-1-26 11:38

回復 8# GBKEE
良師!謝謝!!
       抱歉!!因為硬碟掛了最近的資料全毀
      無奈!請將就吧!辛苦囉謝謝再三!!
作者: GBKEE    時間: 2014-1-26 12:04

回復 10# myleoyes


  
Rng(2).Offset(, i) = "=ROUND(r" & ii & "c6 *" & [M3] & ",2)"

[M3] 沒有數字,需給個數字
作者: myleoyes    時間: 2014-1-26 17:52

回復 11# GBKEE
良師!謝謝!!
        抱歉!急著復原資料卻忘了M3的數據
         M3為任意數字範例為0.0254
        現在程式可以執行但結果並非所需
        差異之處附檔說明LeoV78-2B表示
       測試檔LeoV78-2A
       請不吝賜教真的辛苦囉謝謝再三!!
作者: GBKEE    時間: 2014-1-27 14:54

回復 12# myleoyes

   
按8月鈕正確狀態(因為第2筆在8月為 0 ,AI2等於0筆所以AI6沒有數據)                                                       

不懂請解釋一下,第2筆為何是8月的邏輯.

[attach]17379[/attach]
作者: myleoyes    時間: 2014-1-27 22:58

回復 13# GBKEE
良師!謝謝!!
     ＃假設投入每月配息基金,且配息額非固定額＃
     在5月4日與5月9日分別買入2筆基金
     在5月底配息所以AH3:AI3是2筆的各別配息額
     Z3為配息日期
     在6月14日再買入1筆基金
     在6月底配息所以AH4:AJ4是共3筆的各別配息額
     Z4為配息日期
     以此類推...詳記投資狀態
     模擬8月贖回5月9日的(第2筆)基金
     所以程式會將A4(編號2)變成 0
     也就是說每當任何被贖回的基金編號都會變為 0
     好讓AI2=0組做為程式參照用
     恰巧8月份也沒有買入基金
     在8月底沒贖回的基金息照樣配
     贖回的就沒有配所以AH6:AK6是共3筆的各別配息額
     A4=0(AI2=0組已贖回)所以AI6="",所以只配3筆
     話到此是否納悶?!!為何要建立AH,AI..等等欄的目的
     因為當投資的時間久遠與筆數變多
     當贖回時到底是損益多少??
     尤其是每月有配息且非固定額真的是不道配多少息..
     唯有將數字變成數據才能找到獲利的不二法則
     然而學Excel最迷人的地方就是"模擬"
     透過"精準的數據模擬"就能看到未來值!!
     這是心得.....晚安!!謝謝再三!!
作者: GBKEE    時間: 2014-1-28 06:54

回復 14# myleoyes
有贖回 A欄=0 ,有做這紀錄後,8#的程式碼應是符合你的期望.
作者: myleoyes    時間: 2014-1-28 22:37

回復 15# GBKEE
良師! 謝謝!!請看清楚動畫                                       
請按5月鈕再請看清楚AH3:AI3的數據                                       
AH3:AI3是同時有數據 , 再清除資料                                       
請按良師鈕再請看清楚AH3:AI3的數據                                       
AH3有數據 , 但是AI3卻是空白的                                       
別忘了5月份是買2筆                                       
但卻只配1筆息,請問另一筆息在哪裡???                                       
因為良師的程式是階梯式的方式                                       
只要遇到當月份同時有2筆以上登入會出錯                                       
是程式錯誤的地方你是否注意到呢?                                       
程式不能單單A3對AH3 , A4對AI4 , A5對AJ5                                       
這對每月只買1筆適用,如果每月買多筆是錯誤的                                       
不是嗎?良師明白否?
再附檔試看看辛苦囉!謝謝再三!!
作者: GBKEE    時間: 2014-1-29 06:56

回復 16# myleoyes
  1. Sub Ex()
  2.     Dim C As Integer, i As Integer, R As Integer
  3.     C = [AH1].Column
  4.     R = Cells(Rows.Count, [AH1].Column).End(xlUp).Row + 1
  5.     If R < 3 Then R = 3
  6.     i = 3
  7.     Do While IsDate(Cells(i, "B")) And Cells(i, "B") < Cells(R, "Z")
  8.         If Cells(i, "B") < Cells(R, "Z") Then
  9.             Cells(1, C) = "=SUM(R3C:R200C)"
  10.             Cells(2, C) = "=R" & i & "C1&""筆"""
  11.             Cells(R, C) = "=ROUND(r" & i & "c6 *" & [M3] & ",2)"
  12.             C = C + 1
  13.             i = i + 1
  14.         End If
  15.     Loop
  16. End Sub
複製代碼
作者: myleoyes    時間: 2014-1-29 21:47

回復 17# GBKEE
良師! 非常的謝謝!!
        程式對囉!但卻遺漏 0筆的狀況
                Cells(R, C) = "=ROUND(r" & i & "c6 *" & [M3] & ",2)" 此列
        修改如下
               If Cells(2, C) <> "0筆" Then  Cells(R, C) = "=ROUND(r" & i & "c6 *" & [M3] & ",2)"
         即可真是辛苦你囉!!小弟由衷感激....盡在不言中
              在此誠摯的祝福..... 您與各大版主及各位前輩們!
                                                 新年快樂!!
                一馬當先  躍望一整年.....   感謝大家的教導讓小弟不斷的成長
              謝謝再三!!
作者: myleoyes    時間: 2014-3-12 21:29

回復 17# GBKEE
良師!
    這程式有誤??
    請修改A3不能贖回的問題
    當A3為零時程式喪失判別能力
    無法繼續寫入資料
    如動畫上圖狀態
    辛苦囉!謝謝再三!!
作者: yen956    時間: 2014-3-22 15:09

本帖最後由 yen956 於 2014-3-22 15:15 編輯

回復 19# myleoyes
試試看:
  1. Sub 建立日期比對表()
  2.     Dim i As Integer
  3.     Sheets("Sheet1").Activate
  4.    
  5.     '根據 [B3], 填入連續9個月的 結算日期 到 欄Z
  6.     '並填入連續9個月的 年月 到 欄Y, 供 [Y2] Match 年月 用
  7.     '因為某些月份超過1筆, 且同月份須寫在同一列, 故用 MATCH 比對是否同一月份的資料
  8.     '請修改 For i = 1 To 9 之 9, 如果預計要要建立連續 12個月的資料, 則改為 12
  9.     For i = 1 To 9
  10.         Cells(i + 2, 26) = DateSerial(Year([B3]), Month([B3]) + i, 1) - 1
  11.         Cells(i + 2, 25) = Year(Cells(i + 2, 26)) - 1911 & Month(Cells(i + 2, 26))
  12.     Next i
  13. End Sub

  15. Sub Exyen()
  16.     Dim Rng, chkRng As Range
  17.     Dim i, endRow, endRow2, blankRow As Integer
  18.     endRow = [A2000].End(xlUp).Row
  19.     [AH1].Resize(200, 40) = ""
  20.     [Y3].Resize(200, 2) = ""
  21.     建立日期比對表
  22.     endRow2 = [Y200].End(xlUp).Row
  23.    
  24.     Sheets("Sheet1").Activate
  25.     [M3] = 0.0254                 '此列 "借用" M$3是個變數並非固定值
  26.     blankRow = 3
  27.     oldRow = 3
  28.     Application.Calculation = xlManual
  29.    
  30.     For i = 3 To endRow
  31.    
  32.         '若 Cells(2, i + 31)<>"", 則這筆資料己結算過, 換下一筆
  33.         If Cells(2, i + 31) <> "" Then GoTo next1:
  34.         
  35.         '否則將 編號 寫入 Cells(2, i + 31)
  36.         Cells(2, i + 31) = Cells(i, 1)
  37.         
  38.         '將 目前這一筆 欄B 之 年月放入 [Y1], 供 [Y2] Match 比對年月 用
  39.         [Y1] = Year(Cells(i, 2)) - 1911 & Month(Cells(i, 2))
  40.         
  41.         '因為某些月份超過1筆, 且同月份須寫在同一列, 故用 MATCH 比對是否同一月份的資料
  42.         [Y2] = "=MATCH(Y1,Y3:Y200,0)"
  43.         
  44.         blankRow = [Y2] + 2
  45.         If Cells(i, 1) <> 0 Then
  46.             Range(Cells(blankRow, i + 31), Cells(endRow2, i + 31)) = "=ROUND($F$" & i & "*$M$3,2)"
  47.         Else
  48.             Range(Cells(blankRow, i + 31), Cells(i, i + 31)) = "=ROUND($F$" & i & "*$M$3,2)"
  49.         End If
  50.         Cells(1, i + 31) = "=SUM(R3C" & i + 31 & ":R200C" & i + 31 & ")"
  51. next1:
  52.      Next
  53.      Application.Calculation = xlAutomatic
  54. End Sub
複製代碼
作者: myleoyes    時間: 2014-3-24 21:46

回復 20# yen956
前輩!謝謝!!
         你的想法與範例有所出入
         小弟昨日終於想出解決方法
          式程式如下請參考謝謝再三!!
  1. Sub ExA()
  2.     Dim C As Integer, i As Integer, R As Integer
  3.     [A2] = 1
  4.     [B2] = "=EDATE(B3,-1)"
  5.     [B2].NumberFormatLocal = "[$-404]e/m/d;@"
  6.     C = [Ag1].Column
  7.     R = Cells(Rows.Count, [Ag1].Column).End(xlUp).Row + 1
  8.     If R < 3 Then R = 3
  9.     i = 2
  10.     Do While IsDate(Cells(i, "B")) And Cells(i, "B") < Cells(R, "Z")
  11.         If Cells(i, "B") < Cells(R, "Z") Then
  12.             Cells(1, C) = "=SUM(R3C:R200C)"
  13.             Cells(2, C) = "=R" & i & "C1&""筆"""
  14.          If Cells(2, C) <> "0筆" Then Cells(R, C) = "=ROUND(r" & i & "c6 *" & [M3] & ",2)"
  15.             C = C + 1
  16.             i = i + 1
  17.         End If
  18.     Loop
  19.        Calculate
  20.        [Ag1] = "參照欄"
  21.        [Ag2] = "1筆參照"
  22.        [A2] = 0
  23.        [B2] = "=EDATE(B1,1)"
  24.        [B2].NumberFormatLocal = """日""""期"""
  25.        [Ag3] = 0
  26.     If [Ag4] <> "" Then [Ag4] = 0
  27.     If [Ag5] <> "" Then [Ag3:Ag4].AutoFill Destination:=Range("Ag3:Ag" & [Ag1200].End(xlUp).Row), Type:=xlFillDefault
  28. End Sub
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)