資料剖析+加框線 - Excel程式區 - 麻辣家族討論版版

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

1^# 跳轉到 »

發表於 2017-7-29 08:55 | 顯示全部帖子

本帖最後由 GBKEE 於 2017-7-29 09:58 編輯

回復 1# v03586
試試看

Option Explicit
Sub Ex()
Dim E As Range, sp As Variant, i As Integer, Msg As Boolean, St As String
St = ",AAP,PPA,QQP,POO," '末碼規則
With Range("h2").CurrentRegion
'Range.CurrentRegion 屬性傳回 Range 物件，該物件代表目前的區域。目前區域是指以任意空白列及空白欄的組合為邊界的範圍。唯讀的。
For Each E In .Cells
sp = Split(E.Value, "-")
'Split 函數傳回一個陳列索引從零開始的一維陣列 , 它包含指定數目的子字串
Msg = InStr(St, "," & UCase(UBound(sp)) & ",")
For i = 0 To UBound(sp) - IIf(Msg, 2, 1)
E = Replace(E, sp(i) & "-", "")
'Replace 函數傳回一個字串 , 該字串中指定的子字串已被取代成另一子字串, 並且取代發生的次數也是指定的
Next
Next
.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium, ColorIndex:=xlAutomatic
For Each E In .Cells
With E.Borders(9) 'xlInsideVertical
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = IIf(E.Offset(1) <> E, xlThick, xlMedium)
End With
Next
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2017-7-29 12:29 | 顯示全部帖子

回復 4# v03586

再上傳檔案看看
2#程式碼執行後如圖

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

3^#

發表於 2017-7-29 15:25 | 顯示全部帖子

回復 6# v03586

修改了, 試試看

Option Explicit
Sub Ex()
Dim E As Range, sp As Variant, i As Integer
With Range("h2").CurrentRegion
'Range.CurrentRegion 屬性傳回 Range 物件，該物件代表目前的區域。目前區域是指以任意空白列及空白欄的組合為邊界的範圍。唯讀的。
For Each E In .Cells
sp = Split(E.Value, "-")
'Split 函數傳回一個陳列索引從零開始的一維陣列 , 它包含指定數目的子字串
If UBound(sp) > 2 Then ' 規則, 有第二個『-』,才處裡
For i = 0 To IIf(UBound(sp) > 2, UBound(sp) - 2, 1)
E = Replace(E, sp(i) & "-", "")
'Replace 函數傳回一個字串 , 該字串中指定的子字串已被取代成另一子字串, 並且取代發生的次數也是指定的
Next
End If
Next
.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium, ColorIndex:=xlAutomatic
For Each E In .Cells
With E.Borders(9) 'xlInsideVertical
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = IIf(E.Offset(1) <> E, xlThick, xlMedium)
End With
Next
End With
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

[發問] 資料剖析+加框線