阿昌 發問時間: 電腦與網際網路軟體 · 8 年前

Excel 巨集程式問題

大家好:

以下是在excel 中建立的數值資料,第一欄是「日期」,第二欄是「數值」,第三欄是記錄計算的結果。

我想在Excel中寫個巨集,執行這個巨集計算結果之後,把結果寫在「計算」這一欄的一個儲存格。

我把問題詳述如下:

程式自動搜尋第二欄的網底,

由淺藍變為玫瑰紅時,第一個網底為淺藍的儲存格(B6)減去第一個網底變為玫瑰紅的儲存格(B20),相減的結果再乘以10,……

運算的公式如下:

=(1*(B6-B20)*10)-(1*2*23)-(1*B6*10*0.01)-(1*B20*10*0.01)

公式運算的最終結果寫在B20旁的C20,並把C20的網底變為淺黃色。

程式再繼續搜尋B20以下儲存格的網底,

由玫瑰紅變為淺藍時,第一個網底變為淺藍的儲存格(B42)減去第一個網底變為玫瑰紅的儲存格(B20),相減的結果再乘以10,……

運算的公式如下:

=(1*(B42-B20)*10)-(1*2*23)-(1*B42*10*0.01)-(1*B20*10*0.01)

公式運算的最終結果寫在B42旁的C42,並把C42的網底變為淺黃色。

程式再繼續搜尋B42以下儲存格的網底,

由淺藍變為玫瑰紅時,……

程式會一直往下搜尋下去,直到第二欄無資料為止。

謝謝各位大大的幫忙!

麻煩各位大大在程式中加上一些註解,謝謝!

(不好意思!我不知道如何將 Excel 的網底顏色也貼上來。) 

1日期 數值 計算

22012/5/14100 

32012/5/1598 

42012/5/1695 

52012/5/1794 

62012/5/1890 

72012/5/2185 

82012/5/2282 

92012/5/2380 

102012/5/2477 

112012/5/2575 

122012/5/2872 

132012/5/2968 

142012/5/3067 

152012/5/3165 

162012/6/164 

172012/6/455 

182012/6/556 

192012/6/658 

202012/6/760 

212012/6/862 

222012/6/1164 

232012/6/1265 

242012/6/1370 

252012/6/1475 

262012/6/1577 

272012/6/1880 

282012/6/1982 

292012/6/2081 

302012/6/2180 

312012/6/2282 

322012/6/2585 

332012/6/2688 

342012/6/2790 

352012/6/2892 

362012/6/2995 

372012/7/299 

382012/7/3102 

392012/7/4106 

402012/7/5108 

412012/7/6105 

422012/7/9102 

432012/7/10103 

442012/7/11104 

452012/7/12102 

462012/7/13100 

472012/7/1698 

482012/7/1795 

492012/7/1892 

502012/7/1988 

512012/7/2085 

522012/7/2387 

532012/7/2485 

542012/7/2584 

552012/7/2682 

562012/7/2780 

572012/7/3078 

582012/7/3175 

592012/8/170 

602012/8/368 

612012/8/666 

622012/8/762 

632012/8/860 

642012/8/955 

652012/8/1052 

662012/8/1350 

672012/8/1453 

已更新項目:

在奇摩知識看了幾十篇相關文章,包含Daniel、准提部林兩位大師之前在網路上留下來的程式,今天巳把它寫好了。感激不盡!謝謝!

2 個已更新項目:

請問一下,xC = uF ,uF是什麼意思?

2 個解答

評分
  • 8 年前
    最佳解答

    Sub TEST0816_1()

    Dim xR As Range, xC&, uF&, x, y

    For Each xR In Range("B1", [B65536].End(xlUp))

      xC = xR.Interior.ColorIndex

      If (xC <> 37 And xC <> 38) Or xC = uF Then GoTo 101

      y = xR

    2012-08-16 14:40:41 補充:

      If uF > 0 Then

       xR(1, 2) = (x - y) * 10 - 46 - (x + y) * 0.1

       xR(1, 2).Interior.ColorIndex = 36

      End If

      uF = xC

      x = xR

    101: Next

    End Sub

    2012-08-20 18:50:56 補充:

    EXCEL VBA.逐格檢測〔儲存格底色〕,在顏色變換時,進行計算

                           <.准提部林.>

    -------------------------------

    ■程式碼:

     Sub 執行()

     Dim xR As Range, xC&, uF&, x, y

     For Each xR In Range("B1", [B65536].End(xlUp))

       xC = xR.Interior.ColorIndex

       If (xC <> 37 And xC <> 38) Or xC = uF Then GoTo 101

       y = xR

       If uF > 0 Then

         xR(1, 2) = x + y '計算公式請自行設定  

         xR(1, 2).Interior.ColorIndex = 36

       End If

       uF = xC: x = xR

     101: Next

     Beep

     End Sub

    -------------------------------

    <範例檔>:

    http://www.funp.net/63935

    -------------------------------

    2012-08-21 09:51:14 補充:

    xC 是每一格的〔色號〕

    uF 是上一次記錄下來的〔色號〕,起始值為0

    將範例檔這一行

    101: Next

    改成

    101: xR(1, 3) = uF: Next

    執行後,從D欄即可看出其變化!

    2012-08-21 09:54:06 補充:

    另外,資料第一列若為〔標題〕,

    For Each xR In Range("B1", [B65536].End(xlUp))

    請改為:

    For Each xR In Range("B2", [B65536].End(xlUp))

  • Daniel
    Lv 7
    8 年前

    上面的數據黏在一起,建議上傳範例檔案,較好處理! 並請將欲填的正確解答事先填好,以顏色作判別!

    可將檔案壓縮後,上傳至:

    http://www.funp.net/

    然後貼出下載位址

還有問題?馬上發問,尋求解答。