Excel代码问题，非常感谢！

LSYYLW

2025-4-25.zip (7.31 KB, 下载次数: 3)

2025-4-25 08:12 上传

点击文件名下载附件

quqiyuan

参与一下，仅供参考。。。

quqiyuan

代码如下。。。
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "$T$1" Then
        arr = [c3:f10]
        brr = [w3:w10]
        ReDim crr(1 To UBound(arr), 1 To 1) As Long
        For i = 1 To UBound(arr)
           For j = 1 To UBound(arr, 2)
            If arr(i, j) = brr(i, 1) Then
                crr(i, 1) = brr(i, 1)
                Exit For
            End If
           Next
        Next
        [ac3].Resize(UBound(crr)) = crr
        Beep
    End If
    Application.EnableEvents = True
End Sub
   

LSYYLW

quqiyuan 发表于 2025-4-25 08:57
参与一下，仅供参考。。。

万万分的感谢老师，代码非常非常好用，您完美的为我解决了问题。

LSYYLW

2025-4-25--.zip (12.82 KB, 下载次数: 2)

2025-4-25 11:00 上传

点击文件名下载附件

quqiyuan

参与一下，仅供参考。。。

quqiyuan

代码如下。。。
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "$S$1" Then
        arr = [c3:f6]
        brr = [t3:ai6]
        ReDim crr(1 To UBound(brr), 1 To UBound(brr, 2)) As Long
        For i = 1 To UBound(arr)
            Set d = CreateObject("scripting.dictionary")
            For j = 1 To UBound(arr, 2)
                s = arr(i, j)
                If Len(s) > 0 Then
                    d(s) = ""
                End If
            Next
            For j = 1 To UBound(brr, 2)
                If d.exists(brr(i, j)) Then
                    crr(i, j) = brr(i, j)
                End If
            Next
        Next
        [ak3].Resize(UBound(crr), UBound(crr, 2)) = crr
        Beep
        Set d = Nothing
    End If
    Application.EnableEvents = True
End Sub

LSYYLW

quqiyuan 发表于 2025-4-25 12:26
参与一下，仅供参考。。。

再次万万分的感谢老师，代码非常非常好用，您完美的为我解决了问题。

LSYYLW

2025-4-26.zip (2.9 KB, 下载次数: 2)

2025-4-25 17:16 上传

点击文件名下载附件

quqiyuan

参与一下，仅供参考。。。