Excel代码问题，非常感谢！

quqiyuan

代码如下，，，，

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "$P$1" Then
        arr = [e10:e210]
        arr(UBound(arr), 1) = 0
        brr = [k10:k210]
        ReDim crr(1 To 1000, 0)
        For i = 1 To 17
            brr(i, 1) = Empty
        Next
        For i = 1 To UBound(arr)
            If IsNumeric(arr(i, 1)) And Len(brr(i, 1)) <> 0 Then
                n = n + 1
                crr(n, 0) = brr(i, 1)
            End If
        Next
        [p196].Offset(-n + 1).Resize(n) = crr
        Beep
    End If
    Application.EnableEvents = True
End Sub
   

LSYYLW

quqiyuan 发表于 2024-12-19 13:21
参与一下，仅供参考。。。。

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

LSYYLW

2024-12-20.zip (15.42 KB, 下载次数: 4)

2024-12-20 15:48 上传

点击文件名下载附件

chxw68

修改好了。

quqiyuan

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

quqiyuan

代码如下。。。

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "$P$1" Then
        arr = [e10:e210]
        arr(UBound(arr), 1) = 0
        brr = [k10:k210]
        ReDim crr(1 To 1000, 0)
        For i = 1 To 17
            brr(i, 1) = Empty
        Next
        For i = 1 To UBound(arr)
            If IsNumeric(arr(i, 1)) And Len(brr(i, 1)) <> 0 Then
                n = n + 1
                crr(n, 0) = brr(i, 1)
            End If
        Next
        Range([p196], [p196].End(3)).ClearContents
        [p196].Offset(-n + 1).Resize(n) = crr
        Beep
    End If
    Application.EnableEvents = True
End Sub
   

LSYYLW

chxw68 发表于 2024-12-20 16:59
修改好了。

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

LSYYLW

quqiyuan 发表于 2024-12-20 18:25
参与一下，仅供参考。。。。

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