Excel代码问题，非常感谢！

quqiyuan

LSYYLW 发表于 2025-4-16 08:02

参与一下，仅供参考。。。
19楼的还需要吗。那个麻烦点。

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) = [j1] Then
                Set rng1 = Range(Cells(i, "j"), [j62]).Find(0, , , xlWhole)
                If Not rng1 Is Nothing Then
                    If rng1.Offset(1) = [j2] 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-16 14:15
参与一下，仅供参考。。。
19楼的还需要吗。那个麻烦点。

万万分的感谢老师，代码非常非常好用，您完美的为我解决了问题。
19楼的那个由于没有考虑周全就不需要了，20楼这个完全满足我的需求，让老师您受累了，再次感谢老师!

LSYYLW

2025-4-17-.zip (16.64 KB, 下载次数: 2)

2025-4-17 07:22 上传

点击文件名下载附件

quqiyuan

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

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) = [j1] Then
                Set rng1 = Range(Cells(i, "j"), [j62]).Find(0, , , xlWhole)
                If Not rng1 Is Nothing Then
                    If rng1.Offset(1) = [j2] 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.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

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

LSYYLW

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

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

LSYYLW

2025-4-21.zip (10.57 KB, 下载次数: 2)

2025-4-21 20:33 上传

点击文件名下载附件

quqiyuan

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