快速瀏覽
往期合集：【
2023年3月】【
2023年4月】【
2023年5月】【
2023年6月】【
2023年7月】
實(shí)用案例
|收費(fèi)管理系統(tǒng)|
中醫(yī)診所收費(fèi)系統(tǒng)||日期控件|簡(jiǎn)單的收發(fā)存||電子發(fā)票管理助手|Excel表格拆分神器||Excel多種類型文件合并|收費(fèi)使用項(xiàng)目|
財(cái)務(wù)管理系統(tǒng)|內(nèi)容提要
根據(jù)標(biāo)色的單元格提取號(hào)段
大家好，我是冷水泡茶，今天在論壇上看到一個(gè)求助貼：
數(shù)據(jù)及要求是這樣的：
在我發(fā)完回帖，瀏覽帖子的時(shí)候，發(fā)現(xiàn)樓主又有新的需求：
只列出標(biāo)色的號(hào)段，略一思索，把代碼中未標(biāo)色生成號(hào)段的代碼刪去，運(yùn)行一下，完美！
廢話不多說(shuō)，我們一起來(lái)看一下：
我們?cè)賮?lái)看一下代碼：提取所有號(hào)段代碼
Sub Extract() Dim arrData() Dim lastRow As Integer Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("Sheet1") lastRow = ws.UsedRange.Rows.Count arrData = ws.Range("A1:C" & lastRow).Value For i = 2 To lastRow arrData(i, 3) = Cells(i, 1).Interior.ColorIndex arrData(i, 2) = "" Next t = 2 For i = 2 To lastRow - 1 If arrData(i, 3) = -4142 Then If arrData(i, 1) <> "" Then arrData(t, 2) = arrData(i, 1) & "--" & arrData(i, 1) t = t + 1 End If Else If arrData(i - 1, 3) = -4142 Then m = i ElseIf arrData(i + 1, 3) = -4142 Then arrData(t, 2) = arrData(m, 1) & "--" & arrData(i, 1) t = t + 1 End If End If Next If arrData(lastRow, 3) = -4142 Then arrData(t, 2) = arrData(i, 1) & "--" & arrData(i, 1) Else arrData(t, 2) = arrData(m, 1) & "--" & arrData(lastRow, 1) End If ws.Range("B2:B" & lastRow).NumberFormat = "@" ws.Range("A1").Resize(lastRow - 1, 2) = arrDataEnd Sub代碼解析：1、把數(shù)據(jù)讀入數(shù)組，我還是習(xí)慣用數(shù)組，其實(shí)本案可以直接操作單元格，比數(shù)組方便。2、數(shù)組為n行3列的數(shù)組，通過(guò)循環(huán)把第二列清空，準(zhǔn)備填寫取號(hào)結(jié)果，第三列存入第一列對(duì)應(yīng)單元格的顏色值。3、計(jì)數(shù)器變量t=2，每生成一個(gè)號(hào)段加上1，順序?qū)懭霐?shù)組的第二列。4、通過(guò)判斷第三列顏色值，是否是無(wú)顏色（-4142），如果有顏色，其前后是否是無(wú)顏色，來(lái)確定標(biāo)色的范圍，生成號(hào)段。5、這里循環(huán)到最后第二行，因?yàn)橐袛鄆+1，會(huì)報(bào)錯(cuò)。6、最后判斷一下最后一行有無(wú)標(biāo)色，生成最后一個(gè)號(hào)段。7、把數(shù)組寫入單元格，這里我們只需要第一、第二列，我們從“A1”單元格擴(kuò)展2列。提取標(biāo)色號(hào)段代碼
Sub Extract2() Dim arrData() Dim lastRow As Integer Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("Sheet1") lastRow = ws.UsedRange.Rows.Count arrData = ws.Range("A1:C" & lastRow).Value For i = 2 To lastRow arrData(i, 3) = Cells(i, 1).Interior.ColorIndex arrData(i, 2) = "" Next t = 2 For i = 2 To lastRow - 1 If arrData(i, 3) <> -4142 Then If arrData(i - 1, 3) = -4142 Then m = i ElseIf arrData(i + 1, 3) = -4142 Then arrData(t, 2) = arrData(m, 1) & "--" & arrData(i, 1) t = t + 1 End If End If Next If arrData(lastRow, 3) <> -4142 Then arrData(t, 2) = arrData(m, 1) & "--" & arrData(lastRow, 1) End If ws.Range("B2:B" & lastRow).NumberFormat = "@" ws.Range("A1").Resize(lastRow - 1, 2) = arrDataEnd Sub代碼解析：在“提取所有號(hào)段”的基礎(chǔ)上，把生成未標(biāo)色號(hào)段的代碼刪除，也就是刪除了IF判斷的一個(gè)分支。正文完
喜歡就點(diǎn)個(gè)贊、點(diǎn)在看、留個(gè)言唄！分享一下更給力！感謝！
