Excel代码问题，非常感谢！

quqiyuan

1. =IF(ISNUMBER(F3),COUNTIF(INDIRECT("B"&LOOKUP(1,0/(F$2:F2=0),ROW(F$3:F3))&":B"&ROW()),">0"),H4)

复制代码

LSYYLW

quqiyuan 发表于 2025-3-14 15:33

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

LSYYLW

2025-3-15-.zip (5.55 KB, 下载次数: 3)

2025-3-16 09:17 上传

点击文件名下载附件

quqiyuan

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

quqiyuan

代码如下。。。
  
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$B$1" Then
        arr = [b3:b66]
        brr = [f3:f66]
        ReDim crr(1 To UBound(arr), 0)
        For i = 1 To UBound(arr)
            s = arr(i, 1)
            For j = i To UBound(arr)
                If Not IsNumeric(brr(j, 1)) Then
                    If arr(j, 1) > 0 Then n = n + 1
                Else
                    crr(j, 0) = IIf(arr(j, 1) > 0, n + 1, n)
                    i = j
                    n = 0
                    Exit For
                End If
            Next
        Next
        For i = UBound(crr) To 1 Step -1
            If Len(crr(i, 0)) = 0 Then crr(i, 0) = crr(i + 1, 0)
        Next
        [h3].Resize(UBound(crr)) = Empty
        [h3].Resize(UBound(crr)) = crr
        Beep
    End If
End Sub
   

LSYYLW

quqiyuan 发表于 2025-3-16 13:16
参与一下，仅供参考。。。

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

LSYYLW

2025-3-16--.zip (3.54 KB, 下载次数: 3)

2025-3-16 14:55 上传

点击文件名下载附件

quqiyuan

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

quqiyuan

代码如下。。。
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$H$1" Then
        arr = [h3:h66]
        brr = [l3:l66]
        ReDim crr(1 To UBound(arr), 0)
        For i = 1 To UBound(arr)
            For j = i To UBound(arr)
                If IsNumeric(arr(j, 1)) Then
                    n = n + 1
                    crr(n, 0) = brr(j, 1)
                    i = j
                    Exit For
                End If
            Next
        Next
        Cells(65, "q").Offset(1 - n).Resize(n) = crr
        Beep
    End If
End Sub

LSYYLW

quqiyuan 发表于 2025-3-16 15:15
参与一下，仅供参考。。。

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