【Excel VBA】动态显示结果/动态显示结果 【未完成】

参考：www.360doc.com/content/17/0205/12/1837361_626649321.shtml

视频参考：https://www.365yg.com/i6383122868842004993

学习网站：excel880.com/blog/

----------------------------------------------------------

参考：club.excelhome.net/thread-1204052-1-1.html

效果：

实现代码：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count <> 1 Then Exit Sub
    If Application.Intersect(Target, [e1:g3]) Is Nothing Then Exit Sub
    [b3] = Target
    
End Sub

问题：需要实现的任意单元格的选中，并且输出结果

之前的代码：

Public Sub sss()
 
    Dim str As String, temp As String, CXrng As Range, XRrng As Range
 
    Set CXrng = Selection
 
    For Each XRrng In CXrng
 
        str = str & XRrng.Value
 
        XRrng.ClearContents
 
    Next
 
    CXrng(1) = str
 
End Sub

------------------------------------------------------------

----------------------------

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Call sss
    If Target.Count <> 1 Then Exit Sub
    
    [b3] = Target
    
    
    
End Sub

Public Sub sss()
 
    Dim str As String, temp As String, CXrng As Range, XRrng As Range
 
    Set CXrng = Selection
 
    For Each XRrng In CXrng
 
        str = str & XRrng.Value
 
        
 
    Next
    
    [b3] = str
    
    
 
End Sub

-------------------------------------------------

自动高显 相同内容：

参考：club.excelhome.net/thread-1266969-1-1.html

代码：

Sub zz()
    Set d = CreateObject("Scripting.Dictionary")
    For i = 2 To [a65536].End(3).Row
        d(Cells(i, "o").Value) = d(Cells(i, "o").Value) + 1
        Cells(i, "r") = d(Cells(i, "o").Value)
        If d(Cells(i, "o").Value) > 1 Then Cells(i, "q") = "重复"
    Next
End Sub

Sub dd()
Dim d As Object, arr, brr, i&, j&, k&
Set d = CreateObject("scripting.dictionary")
arr = Range("o1:p" & Cells(Rows.Count, "o").End(3).Row)
ReDim brr(1 To UBound(arr), 1 To 2)
For i = 2 To UBound(arr)
    If Not d.exists(arr(i, 1)) Then
        d(arr(i, 1)) = 1
        Else
        d(arr(i, 1)) = d(arr(i, 1)) + 1
        brr(i, 2) = d(arr(i, 1))
        brr(i, 1) = "重复"
    End If
Next
For i = 2 To UBound(arr)
    If brr(i, 1) = "" Then
        If d(arr(i, 1)) <> 1 Then
            brr(i, 1) = "重复"
            brr(i, 2) = 1
        End If
    End If
Next
[q1].Resize(UBound(arr), 2) = brr
Set d = Nothing
End Sub

----------------------------------------------------------