自动填充序号

明远风

quqiyuan

醉眼看尘世

代码冗余太多，可以写成一句，如：
[b9].resize(cells(rows.count,4).end(3).row-8,1)="=sum(....)"

淡__

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. Dim x, y
   
3. x = Target.Row: y = Target.Column
   
4.     If Not Application.Intersect(Range("d:d"), Target) Is Nothing And x > 1 Then
   
5.      If Cells(x, y - 1) <> "" And Cells(x, y) <> "" Then
   
6.      Cells(x, y - 2) = WorksheetFunction.Max(Range(Cells(1, y - 2), Cells(x - 1, y - 2))) + 1
   
7.      End If
   
8.     End If
   
9. End Sub

复制代码

沈默00

代码里写公式？  多余的
直接循环就可以了，，，

z865593849

icenotcool

各位老师，可以看看我的求助贴吗？跨表提取不重复数据并按条件汇总（去重求和）-Excel VBA程序开发-ExcelHome技术论坛 -  https://club.excelhome.net/forum ... amp;_dsign=91595a5e
Sub Total()
    Set d = CreateObject("scripting.dictionary")
    Application.ScreenUpdating = False
    arr = Sheets("系统导出").UsedRange
    r = 0
    For j = 1 To UBound(arr)
        If arr(j, 9) = "金额" Then
            If d.exists(arr(j, 9) & "") Then
                X = d(arr(j, 9) & "")
                arr(X, 6) = arr(X, 6) + arr(j, 6)
            Else
                r = r + 1
                d(arr(j, 9) & "") = r
                arr(r, 1) = arr(j, 1)
                arr(r, 2) = arr(j, 2)
                arr(r, 3) = arr(j, 3)
                arr(r, 4) = arr(j, 8)
                arr(r, 5) = arr(j, 7)
                arr(r, 6) = arr(j, 9)
            End If
        End If
    Next j
    If r > 0 Then [A1].Resize(r, 6) = arr
    Application.ScreenUpdating = True
End Sub

niko88819

沈默00 发表于 2024-9-27 07:47
代码里写公式？  多余的
直接循环就可以了，，，

老师，写个示例让小师妹学习