- 帖子
- 1447
- 主題
- 40
- 精華
- 0
- 積分
- 1471
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-3-24
|
本帖最後由 Andy2483 於 2023-3-31 11:20 編輯
回復 8# coafort
謝謝前輩回復
後學藉此帖練習觸發與字典,學習方案如下,請前輩參考
執行前:
輸入8的執行結果:
'工作表模組:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
On Error Resume Next
Names("_AAA").Delete
On Error GoTo 0
If .Row < 3 Or .Value = "" Then Exit Sub
If .Column Mod 7 <> 1 Then Exit Sub
Cancel = True
Names.Add "_AAA", Target.Value
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .Row < 3 Or .Count > 1 Then Exit Sub
If .Column Mod 7 = 4 Then
Call 填入配息_多個同股名
If Val(Y(.Offset(0, -3) & "|")) > 1 Then
Application.EnableEvents = False
Y(.Offset(0, -3) & "/").Value = .Value
Application.EnableEvents = True
Application.Goto Y(.Offset(0, -3) & "/")
Set Y = Nothing
End If
End If
If .Column Mod 7 = 6 Then
Call 填入配股_多個同股名
If Val(Y(.Offset(0, -5) & "|")) > 1 Then
Application.EnableEvents = False
Y(.Offset(0, -5) & "/").Value = .Value
Application.EnableEvents = True
Application.Goto Y(.Offset(0, -5) & "/")
Set Y = Nothing
End If
End If
End With
End Sub
'Module1:
Option Explicit
Public Y
Sub 填入配息_多個同股名()
Dim Brr, C&, i&, R&
Set Y = CreateObject("Scripting.Dictionary")
Brr = ActiveSheet.UsedRange
For C = 1 To UBound(Brr, 2) Step 7
For R = 3 To UBound(Brr)
Y(Brr(R, C) & "|") = Y(Brr(R, C) & "|") + 1
If Y(Brr(R, C) & "/") = "" Then
Set Y(Brr(R, C) & "/") = Cells(R, C + 3)
Else
Set Y(Brr(R, C) & "/") = Union(Y(Brr(R, C) & "/"), Cells(R, C + 3))
End If
Next
Next
End Sub
Sub 填入配股_多個同股名()
Dim Brr, C&, i&, R&
Set Y = CreateObject("Scripting.Dictionary")
Brr = ActiveSheet.UsedRange
For C = 1 To UBound(Brr, 2) Step 7
For R = 3 To UBound(Brr)
Y(Brr(R, C) & "|") = Y(Brr(R, C) & "|") + 1
If Y(Brr(R, C) & "/") = "" Then
Set Y(Brr(R, C) & "/") = Cells(R, C + 5)
Else
Set Y(Brr(R, C) & "/") = Union(Y(Brr(R, C) & "/"), Cells(R, C + 5))
End If
Next
Next
End Sub |
|
發表於 2023-3-31 11:18
| 
