- 帖子
- 2798
- 主題
- 10
- 精華
- 0
- 積分
- 2854
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-4-15
|
用最基本的程式語法, 自行去研究, 不再多說明~~- Sub TEST()
- Dim R&, xArea As Range, xR As Range, xH As Range, T, TT, X
- R = [報表!A65536].End(xlUp).Row: If R < 9 Then Exit Sub
- Set xArea = Sheets("報表").Range("A9:A" & R)
- For Each xR In xArea
- T = xR(1, 3): xR(1, 3) = Mid(T, InStr(T, "-") + 1)
- xR(1, 4) = Right(xR(1, 4), 9)
-
- T = xR(1, 5): T = Left(T, 2) & "-" & Mid(T, 3, 1) & "-" & Mid(T, 4, 4)
- TT = Application.VLookup(T, [Flow!A:B], 2, 0)
- If Not IsError(TT) Then xR(1, 5) = TT Else xR(1, 5).Font.Color = vbRed
-
- T = xR(1, 6)
- T = Mid(T & ",QVS", InStr(T, "QVS") + 4) '取 QVS 以後字串
- For Each TT In Array("SPC", "SCL")
- X = InStr(T, TT): If X > 0 Then xR(1, 6) = Left(T, X + 2): Exit For
- Next
- Next
-
- xArea.Resize(, 6).Sort Key1:=xArea(1, 1), Order1:=xlAscending, _
- Key2:=xArea(1, 4), Order2:=xlAscending, Header:=xlNo
-
- Application.DisplayAlerts = False
- For Each xR In xArea
- If xR & xR(1, 2) <> xR(0) & xR(0, 2) Then Set xH = xR
- If xR & xR(1, 2) <> xR(2) & xR(2, 2) Then
- Range(xH, xR).Merge: Range(xH(1, 2), xR(1, 2)).Merge
- Range(xH, xR(1, 6)).Borders.LineStyle = 1
- For i = 7 To 10
- Range(xH, xR(1, 6)).Borders(i).Weight = xlMedium
- Next i
- End If
- Next
- End Sub
|
|
發表於 2016-1-13 13:52
| 
