- ©«¤l
- 122
- ¥DÃD
- 26
- ºëµØ
- 0
- ¿n¤À
- 148
- ÂI¦W
- 0
- §@·~¨t²Î
- windos10
- ³nÅ骩¥»
- office2016
- ¾\ŪÅv
- 20
- µù¥U®É¶¡
- 2021-7-8
- ³Ì«áµn¿ý
- 2023-8-28
|
¦^´_ 16# Andy2483
½Ð¨DAndy2483¤j¤jªº¸Ñ´b
"¡¹"®ø¥¢¤F¡A½Ð°Ý§Ú§ïªº»yªkþ¸Ì¥X¿ù¤F?
Option Explicit
Sub «ö¶s22_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 = "¤Å§R«æ¥ó¤½¦¡.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([±M®×!Z1], [±M®×!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 |
|