求个代码

quqiyuan

wenping998 发表于 2024-6-15 17:39
大哥 成了 如果行数有10000行  需要怎么改代码

行数没有影响，多少行都可以，只要你A列数字比D列--S列最后那个数据，下来一格就可以了，列那边有关系的所以列不能变，列使用了两个不同的代码来运算的

wenping998

quqiyuan 发表于 2024-6-15 17:43
行数没有影响，多少行都可以，只要你A列数字比D列--S列最后那个数据，下来一格就可以了，列那边有关系的 ...

那列数 有变化 有增加的话 该 怎么改呢

quqiyuan

wenping998 发表于 2024-6-15 17:56
那列数 有变化 有增加的话 该 怎么改呢

可以当然可以，有些地方还是要注意一下就行了

wenping998

quqiyuan 发表于 2024-6-15 18:22
可以当然可以，有些地方还是要注意一下就行了

大哥太厉害了 感谢大哥周末还帮忙弄代码 反应很迅速 再一次感谢大哥帮助 以后再遇到困难再找大哥求助啊

wenping998

quqiyuan 发表于 2024-6-15 18:22
可以当然可以，有些地方还是要注意一下就行了

大哥 你用的WPS吗  有免费办的VBA模块吗  求推荐 我找的用不了

quqiyuan

wenping998 发表于 2024-6-19 13:06
大哥 你用的WPS吗  有免费办的VBA模块吗  求推荐 我找的用不了

我的是M365.。。

wenping998

quqiyuan 发表于 2024-6-15 18:22
可以当然可以，有些地方还是要注意一下就行了

大哥 还得麻烦您下  看能不能在表格里插一行  然后只显示该列的最后一个数字  比如如图 插了个2行 所有的数字就都在3行了 然后U2 Y2 W2格显示的是该列最后一个数字  数字每天更新 也就每天需要变化了 看可以用代码实现吗

quqiyuan

wenping998 发表于 2024-9-27 10:09
大哥 还得麻烦您下  看能不能在表格里插一行  然后只显示该列的最后一个数字  比如如图 插了个2行 所有的 ...

我看看，时间很久的事情了

quqiyuan

quqiyuan

代码如下。。。
Sub test2()       '2024-9-27修改                                       'instr的方法
    Application.ScreenUpdating = False
    For Each sht In ThisWorkbook.Sheets
        r = 0: m = 0: x = 0
        For i = 1 To 16
           r_1 = sht.Cells(Rows.Count, i + 3).End(3).Row
           r = Application.Max(r, r_1)
        Next
        arr = sht.Range(sht.[a3], sht.Cells(r + 1, "s"))
        c = sht.Cells(1, sht.Columns.Count).End(1).Column
        brr = sht.Range(sht.[t1], sht.Cells(1, c))
        ReDim crr(1 To UBound(arr) + 1, 1 To UBound(brr, 2) + 1)
        For j = 1 To UBound(brr, 2) Step 2
            If j < 72 Then
                n = 2
                crr(n, j) = 1
                For i = 2 To UBound(arr)
                    If arr(i, 4) <> "" Then
                        If InStr(brr(1, j), arr(i, 4)) Then
                            n = n + 1
                            crr(n, j) = arr(i, 1)
                            m = Application.Max(m, n)
                            If n = 1 Then crr(n, j + 1) = Empty Else crr(n, j + 1) = crr(n, j) - crr(n - 1, j) - 1
                        End If
                    ElseIf i = UBound(arr) Then
                            n = n + 1
                            crr(n, j) = arr(i, 1)
                            m = Application.Max(m, n)
                            If n = 1 Then crr(n, j + 1) = Empty Else crr(n, j + 1) = crr(n, j) - crr(n - 1, j) - 1
                    End If
                Next
                crr(1, j + 1) = crr(n, j + 1)
            Else
                n = 2: x = x + 1
                crr(n, j) = 1
                For i = 2 To UBound(arr)
                    If brr(1, j) = CStr(arr(i, x + 4)) Then
                        n = n + 1
                        crr(n, j) = arr(i, 1)
                        m = Application.Max(m, n)
                        If n = 1 Then crr(n, j + 1) = Empty Else crr(n, j + 1) = crr(n, j) - crr(n - 1, j) - 1
                    End If
                    If i = UBound(arr) Then
                        n = n + 1
                        crr(n, j) = arr(i, 1)
                        m = Application.Max(m, n)
                        crr(n, j + 1) = crr(n, j) - crr(n - 1, j) - 1
                    End If
                Next
            End If
            crr(1, j + 1) = crr(n, j + 1)
        Next
        sht.[t2].Resize(sht.[t2].CurrentRegion.Rows.Count, UBound(crr, 2)).ClearContents
        sht.Cells(2, "t").Resize(m, UBound(crr, 2)) = crr
    Next
    Application.ScreenUpdating = True
    Beep
End Sub