Excel代码问题，非常感谢！

LSYYLW

20250411.zip (2.67 KB, 下载次数: 2)

2025-4-11 07:31 上传

点击文件名下载附件

quqiyuan

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

quqiyuan

代码如下。。。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    arr = Range([l2], [l82].End(3))
    s = [g12]
    x = Application.Match(s, arr, 0)
    If Target.Address = "$B$21" Then
        If x = UBound(arr) Then x = 0
        [g12] = Application.Index(arr, x + 1)
        [b24].Select
    ElseIf Target.Address = "$B$27" Then
        If x = 1 Then x = UBound(arr) + 1
        [g12] = Application.Index(arr, x - 1)
        [b24].Select
    End If
End Sub

LSYYLW

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

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

LSYYLW

2025-4-14.zip (3.5 KB, 下载次数: 2)

2025-4-14 20:22 上传

点击文件名下载附件

quqiyuan

参与一下，仅供参考。。。
我的理解是只要间隔一个0，就是要下一个数组最后一个数字

quqiyuan

代码如下，，，

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "$I$1" Then
        Set Rng = [j3:j62]
        arr = Rng
        ReDim brr(1 To UBound(arr)) As Long
        For i = 3 To UBound(arr) + 2
            If arr(i - 2, 1) <> 0 Then
                Set rng1 = Range(Cells(i, "j"), [j62]).Find(0, , , xlWhole)
                If Not rng1 Is Nothing Then
                    If rng1.Offset(1) <> 0 Then
                        Set rng2 = Range(rng1.Offset(1), [j62]).Find(0, , , xlWhole)
                        If Not rng2 Is Nothing Then
                            brr(rng2.Row - 3) = rng2.Offset(-1).Value
                        Else
                            brr(UBound(arr)) = arr(UBound(arr), 1)
                        End If
                    End If
                    i = rng1.Offset(1).Row
                Else
                    i = UBound(arr) + 2
                End If
            End If
        Next
        [q3].Resize(UBound(arr)) = Application.Transpose(brr)
        Beep
    End If
    Application.EnableEvents = True
End Sub
   

LSYYLW

quqiyuan 发表于 2025-4-14 22:07
参与一下，仅供参考。。。
我的理解是只要间隔一个0，就是要下一个数组最后一个数字

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

LSYYLW

2025-4-15.zip (15.56 KB, 下载次数: 2)

2025-4-15 14:41 上传

点击文件名下载附件

LSYYLW

2025-4-16.zip (15.74 KB, 下载次数: 2)

2025-4-16 08:02 上传

点击文件名下载附件