Excel代码问题，非常感谢！

quqiyuan

代码如下。。。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "$J$14" Then
        arr = [f10:k10]
        x = Application.Match([p6], arr, 0)
        If IsNumeric(x) Then
            If x = 6 Then x = 0
            x = x + 1
            [p6] = Application.Index(arr, x)
            [f10].Select
        End If
    End If
    Application.EnableEvents = True
End Sub

LSYYLW

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

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

LSYYLW

2025-4-22.zip (2.51 KB, 下载次数: 3)

2025-4-22 11:09 上传

点击文件名下载附件

quqiyuan

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

quqiyuan

代码如下。。。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "$H$23" Then
        arr = [h12:h16]
        ReDim brr(1 To 3, 0)
        Set d = CreateObject("scripting.dictionary")
        For i = UBound(arr) To 1 Step -1
            s = arr(i, 1)
            If Not d.exists(s) Then
                n = n + 1
                d(s) = n
            End If
        Next
        Key = d.keys
        m = 4
        For i = 1 To n
            m = m - 1
            If m > 0 Then brr(m, 0) = Key(i - 1) Else Exit For
        Next
        [h18:h20].ClearContents
        [h18:h20] = brr
        [h12].Select
    End If
    Application.EnableEvents = True
End Sub

LSYYLW

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

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

LSYYLW

2025-4-24-.zip (20.91 KB, 下载次数: 2)

2025-4-24 16:59 上传

点击文件名下载附件

quqiyuan

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

quqiyuan

代码如下。。。
Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Address = "$G$1" Then
        s = [h771]
        Set Rng = [h2:h770]
        ReDim crr(1 To 769, 1 To 1) As Long
        If [g1] = 1 Then
            Rng.Value = s
        ElseIf [g1] = 2 Then
            If s = 80 Then s = 0
            crr(UBound(crr), 1) = s + 1
            For i = UBound(crr) To 2 Step -1
                If crr(i, 1) < 80 Then
                    crr(i - 1, 1) = crr(i, 1) + 1
                Else
                    crr(i - 1, 1) = 1
                End If
            Next
            Rng.Value = crr
        ElseIf [g1] = 3 Then
            If s = 1 Then s = 81
            crr(UBound(crr), 1) = s - 1
            For i = UBound(crr) To 2 Step -1
                If crr(i, 1) > 1 Then
                    crr(i - 1, 1) = crr(i, 1) - 1
                Else
                    crr(i - 1, 1) = 80
                End If
            Next
            Rng.Value = crr
        End If
        Beep
    End If
    Application.EnableEvents = True
End Sub
   

LSYYLW

quqiyuan 发表于 2025-4-24 19:14
参与一下，仅供参考。。。

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