- 帖子
- 122
- 主題
- 26
- 精華
- 0
- 積分
- 148
- 點名
- 0
- 作業系統
- windos10
- 軟體版本
- office2016
- 閱讀權限
- 20
- 註冊時間
- 2021-7-8
- 最後登錄
- 2023-8-28
|
回復 16# Andy2483
請求Andy2483大大的解惑
"★"消失了，請問我改的語法哪裡出錯了?
Option Explicit
Sub 按鈕22_Click()
Application.ScreenUpdating = False
Dim Brr, Z, A, B, i&, R&, T$, T1$, PH$, FN$, xB As Workbook, Sh As Worksheet
Set Z = CreateObject("Scripting.Dictionary")
PH = ThisWorkbook.Path: FN = "勿刪急件公式.xlsm"
On Error Resume Next
Set xB = Workbooks(FN): Set Sh = xB.Sheets("異動表排序")
Brr = Range(Sh.[E1], Sh.[A65536].End(3))
On Error GoTo 0
If xB Is Nothing Then
Set xB = Workbooks.Open(PH & "\" & FN)
Brr = Range([異動表排序!E1], [異動表排序!A65536].End(3))
xB.Close 0
End If
For i = 1 To UBound(Brr)
T = Brr(i, 1): If T = "" Then GoTo i00
T1 = Brr(i, 1): A = Z(T1)
If A = "" Then
For R = i To UBound(Brr)
If T1 <> Brr(R, 1) Then Z(T1) = A: Exit For
B = " " & Brr(R, 2) & " " & Brr(R, 3) & " " & Brr(R, 4) & " " & Brr(R, 5)
If i = R Then A = Brr(R, 1) & vbLf & B Else A = A & vbLf & B
Next
End If
If Z(T) = "" Then
Z(T) = Z(T1)
ElseIf InStr(Z(T), Z(T1)) = 0 Then
Z(T) = Z(T) & vbLf & vbLf & Z(T1)
End If
i00: Next
Brr = Range([專案!Z1], [專案!Z65536].End(3))
[Z:Z].ClearComments
For i = 1 To UBound(Brr)
T1 = Brr(i, 1): If T1 = "" Or Z(T1) = "" Then GoTo i01
With Cells(i, 26).AddComment
.Text Text:=Replace(Z(T1), " " & T1, "★" & T1)
.Shape.TextFrame.Characters.Font.Size = 16
.Shape.DrawingObject.AutoSize = True
End With
i01: Next
Set Z = Nothing: Erase Brr: Set xB = Nothing: Set Sh = Nothing
End Sub |
|
發表於 2023-6-25 13:08
| 
