Excel代码问题，非常感谢！

LSYYLW

quqiyuan 发表于 2025-4-9 21:52
参与一下，仅供参考。。。

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

LSYYLW

quqiyuan 发表于 2025-4-9 21:52
参与一下，仅供参考。。。

老师您好：刚刚您帮我解决的问题，我忘了一个条件，就是E列和F列里的数字变动后，非0数字有可能会减少，麻烦老师您帮我加上一个自动清除上次显示过的残留数字的功能，我参考老师您以前帮我解决过的类似问题，添加语句后没有成功，老师您受累，有时间的时候帮我解决一下，拜托您了！

quqiyuan

LSYYLW 发表于 2025-4-9 22:15
老师您好：刚刚您帮我解决的问题，我忘了一个条件，就是E列和F列里的数字变动后，非0数字有可能会减少， ...

quqiyuan

代码如下。。。
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "$E$1" Then
        arr = [e8:f97]
        [j8:k97].ClearContents
        For j = 1 To 2
            n = 0
            ReDim crr(1 To UBound(arr), 0)
            For i = 1 To UBound(arr)
                If arr(i, j) <> 0 Then
                    n = n + 1
                    crr(n, 0) = arr(i, j)
                End If
            Next
            [j97].Offset(1 - n, j - 1).Resize(n) = crr
        Next
        Beep
    End If
    Application.EnableEvents = True
End Sub
   

LSYYLW

quqiyuan 发表于 2025-4-10 07:28

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

LSYYLW

2025-4-11.zip (2.57 KB, 下载次数: 5)

2025-4-10 10:21 上传

点击文件名下载附件

quqiyuan

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

quqiyuan

代码如下。。。
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "$P$1" Then
        arr = [c5:r10]
        [t2:t31].ClearContents
        n = 0
        ReDim crr(1 To 1000, 0)
        For i = 1 To UBound(arr)
            For j = 1 To UBound(arr, 2)
                If Len(arr(i, j)) > 0 Then
                    n = n + 1
                    crr(n, 0) = arr(i, j)
                End If
            Next
            If n Then [t2].Resize(n) = crr
        Next
        Beep
    End If
    Application.EnableEvents = True
End Sub

LSYYLW

2025-4-11---.zip (3.66 KB, 下载次数: 3)

2025-4-10 13:08 上传

点击文件名下载附件

LSYYLW

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

万万分的感谢老师，代码非常非常好用，您完美的为我解决了问题。
实在是不好意思，今天还得再麻烦老师您一下，麻烦您帮我看一下38楼附件里的问题，在您有时间的时候帮我看一下，帮我解决一下，拜托您了！