返回列表下一主題上一主題發帖

[發問] MARCO公式合併儲存格.和用顏色:黃色分開不相同

john2006168

　暱稱: jjjohn

中學生 Rank: 2

帖子: 178
主題: 65
精華: 0
積分: 252
點名: 0
作業系統: WINDOW7
軟體版本: Office 2010
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2010-5-4
最後登錄: 2024-2-1

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2019-3-5 12:46 | 只看該作者

[發問] MARCO公式合併儲存格.和用顏色:黃色分開不相同

想問一下大大高手,有沒有簡單的MARCO或者公式可以做到F欄的效果—(計算每個BATCH 的總和,),然後合併儲存格.
另外,是否可以有MARCO用顏色:黃色分開不相同的BATCH NO,方便查看?
小弟現在在學習階段,只可以慢慢抄學中,希望有人可以分享

FYI.PNG (10.06 KB)

TEST 05MAR.zip (6.29 KB)

樓主熱帖

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-23

7^#

發表於 2019-3-9 09:55 | 只看該作者

回復 6# john2006168

Sub TEST()
Dim xR As Range, CL, U%, xH As Range, SS
Call 重置
CL = Array(35, 36)
For Each xR In Range("D2:D" & Cells(Rows.Count, "k").End(xlUp).Row)  '以k欄取資料列數, xR則從D2往下迴圈
If xR(1, 8) <> xR(0, 8) Then Set xH = xR: SS = 0 'xR(1,8) D欄往右8格, 即是K欄; xR(1, 8) <> xR(0, 8) 1是本格,0是上一格,2是下一格 ---以下程式碼同理
SS = SS + Val(xR(1, 2))
If xR(1, 8) <> xR(2, 8) Then
   xH(1, 3) = SS: U = 1 - U
   Range(xR(1, 8), xH).Interior.ColorIndex = CL(U)
   Range(xH(1, 3), xR(1, 3)).Merge
End If
Next
End Sub

Sub 重置()
With Range([D2], Cells(Rows.Count, "k").End(xlUp))
   .UnMerge
   .Interior.ColorIndex = 0
   .Columns(3).ClearContents
End With
End Sub

TOP

john2006168

　暱稱: jjjohn

中學生 Rank: 2

帖子: 178
主題: 65
精華: 0
積分: 252
點名: 0
作業系統: WINDOW7
軟體版本: Office 2010
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2010-5-4
最後登錄: 2024-2-1

6^#

發表於 2019-3-8 23:59 | 只看該作者

回復 4# 准提部林

老師想問一下,如果我將batch no放到欄K ,寫法思路是否不同,應該如何寫?

未命名.png (417.12 KB)

TOP

john2006168

　暱稱: jjjohn

中學生 Rank: 2

帖子: 178
主題: 65
精華: 0
積分: 252
點名: 0
作業系統: WINDOW7
軟體版本: Office 2010
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2010-5-4
最後登錄: 2024-2-1

5^#

發表於 2019-3-8 23:41 | 只看該作者

回復 4# 准提部林

多謝大大幫忙,慢慢學習中

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-23

4^#

發表於 2019-3-6 19:32 | 只看該作者

Sub TEST()
Dim xR As Range, CL, U%, xH As Range, SS
Call 重置
CL = Array(35, 36)
For Each xR In Range([C2], Cells(Rows.Count, "c").End(xlUp))
If xR <> xR(0) Then Set xH = xR: SS = 0
SS = SS + Val(xR(1, 3))
If xR <> xR(2) Then
   xH(1, 4) = SS: U = 1 - U
   Range(xR, xH(1, 8)).Interior.ColorIndex = CL(U)
   Range(xH(1, 4), xR(1, 4)).Merge
End If
Next
End Sub

Sub 重置()
With Range([J2], Cells(Rows.Count, "c").End(xlUp))
   .UnMerge
   .Interior.ColorIndex = 0
   .Columns(4).ClearContents
End With
End Sub