帖子: 163
主題: 45
精華: 0
積分: 246
點名: 28
作業系統: win7
軟體版本: ie
閱讀權限: 20
性別: 男
註冊時間: 2015-7-8
最後登錄: 2024-12-7

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2020-7-15 18:37 | 只看該作者

特定顏色儲存格排序問題

各位大大,你好

我設定了公式是當B欄儲存格是有顏色時(不是基本的256色,是淺紫色),
A欄就會重新由1開始由順序編號,如B欄有標記顏色, A欄就不會有編號

但如果我想在某一列加插一種顏色做標記時(不是淺紫色),在執行程式時又不會加插編號,請問我應怎樣可以做到,除了特定顏色外(不是基本的256色)其他都可以做到順序呢??

謝謝

庫存表.rar (86.05 KB)

樓主熱帖

mdr0465

中學生 Rank: 2

帖子: 163
主題: 45
精華: 0
積分: 246
點名: 28
作業系統: win7
軟體版本: ie
閱讀權限: 20
性別: 男
註冊時間: 2015-7-8
最後登錄: 2024-12-7

6^#

發表於 2020-7-17 06:41 | 只看該作者

回復 5# 准提部林

版主，謝謝你你再一次出手幫助
萬分感激
謝謝

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

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

5^#

發表於 2020-7-16 14:02 | 只看該作者

本帖最後由准提部林於 2020-7-16 16:23 編輯

有點繞, 試試~~

Sub Test2()
Dim R&, xR As Range, xH As Range, xE As Range, T1$, T2$, N&
Application.ScreenUpdating = False
With [A:A]: .UnMerge: .ClearContents: .HorizontalAlignment = 3: End With
R = [B65536].End(xlUp).Row
For Each xR In Range("B5:B" & R)
If xR.Interior.ColorIndex = 24 Then N = 0: GoTo 101
T1 = Left(xR, 11): If T1 = "" Then GoTo 101
If T2 <> "" And T1 <> T2 Then Range(xH, xE).Merge: T2 = ""
If T1 <> T2 Then Set xH = xR(1, 0): N = N + 1: xH = N: T2 = T1
If T1 = T2 Then Set xE = xR(1, 0)
If xR.Row = R Then Range(xH, xE).Merge
101: Next
Range([A5], xE).Borders.LineStyle = 1
End Sub

=============================

TOP

mdr0465

中學生 Rank: 2

帖子: 163
主題: 45
精華: 0
積分: 246
點名: 28
作業系統: win7
軟體版本: ie
閱讀權限: 20
性別: 男
註冊時間: 2015-7-8
最後登錄: 2024-12-7

4^#

發表於 2020-7-16 10:18 | 只看該作者

回復 2# n7822123

成功了，謝謝你

TOP

mdr0465

中學生 Rank: 2

帖子: 163
主題: 45
精華: 0
積分: 246
點名: 28
作業系統: win7
軟體版本: ie
閱讀權限: 20
性別: 男
註冊時間: 2015-7-8
最後登錄: 2024-12-7

3^#

發表於 2020-7-16 09:34 | 只看該作者

回復 2# n7822123 [/b
你好
謝謝指教，但我執行程式時都在淺紫色是沒有重新由一開始排序，請賜教，謝謝

TOP

n7822123

　暱稱: 阿龍

中學生 Rank: 2

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

2^#

發表於 2020-7-16 02:08 | 只看該作者

本帖最後由 n7822123 於 2020-7-16 02:23 編輯

回復 1# mdr0465

如果不是看了附件，只單純看你的文字敘述的話，還真的是看不太懂!

這樣吧，我整理了一下你的需求，你再看看是不是你要的

1.當B欄有資料時，A欄要給編號，且從1開始，無資料則跳過不給編號

2.當B欄有資料時，但是B欄有顏色 (不是無色，也不是淡紫色)，則A欄不給編號

3.B欄前11碼若一樣，則A欄編號一樣，且要合併儲存格?

4.B欄遇到淺紫色(只認淺紫色)，A欄編號重置，下次再從1開始

程式如下

Sub Test()
Dim Arr, Brr As Range, R&, Idx&
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Brr = Range([A4], Cells(Rows.Count, 2).End(3))
With Brr.Resize(, 1)
.UnMerge: .Borders.LineStyle = 1
.ClearContents: .HorizontalAlignment = 3
End With
Arr = Brr
For R = 2 To UBound(Arr)
  If Arr(R, 2) <> "" And Brr(R, 2).Interior.ColorIndex = xlNone Then
If Left(Arr(R, 2), 11) <> Left(Arr(R - 1, 2), 11) Then
   Idx = Idx + 1: Arr(R, 1) = Idx
Else  '合併儲存格
   Range(Brr(R, 1), Brr(R - 1, 1)).Merge
End If
  End If
  If Brr(R, 2).Interior.Color = RGB(217, 226, 243) Then Idx = 0
Next R
Brr = Arr
End Sub

檔案如下

庫存表.rar (116.62 KB)

程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP