Excel代码问题，非常感谢！

LSYYLW

quqiyuan 发表于 2024-10-31 19:00
参与一下，仅供参考，，，

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

LSYYLW

2024-11-1.zip (2.65 KB, 下载次数: 2)

2024-11-1 07:05 上传

点击文件名下载附件

LSYYLW

quqiyuan 发表于 2024-10-31 19:00
代码如下。。。
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents =  ...

老师您好：又来麻烦您了，您有时间帮我看一下32楼附件里的问题，帮我解决一下，拜托了！

quqiyuan

LSYYLW 发表于 2024-11-1 07:07
老师您好：又来麻烦您了，您有时间帮我看一下32楼附件里的问题，帮我解决一下，拜托了！

quqiyuan

代码如下。。。

   
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "$L$1" Then
        arr = [e9:f68]
        Set d = CreateObject("scripting.dictionary")
        Set d1 = CreateObject("scripting.dictionary")
        For j = 1 To UBound(arr, 2)
            For i = 1 To UBound(arr)
                s = arr(i, 1): ss = arr(i, 2)
                If s <> 0 Then d(i) = s
                If ss <> 0 Then d1(i) = ss
            Next
        Next
        [l63].CurrentRegion.ClearContents
        Cells(63 - d.Count + 1, "l").Resize(d.Count) = Application.Transpose(d.items)
        Cells(63 - d1.Count + 1, "m").Resize(d1.Count) = Application.Transpose(d1.items)
    End If
    Application.EnableEvents = True
End Sub
   

LSYYLW

quqiyuan 发表于 2024-11-1 08:33
代码如下。。。

   

万分的感谢老师，代码非常好用，鲜花稍后为您献上。