Excel代码问题，非常感谢！

LSYYLW · 发表于 2024-6-25 12:14

cidanji 发表于 2024-6-25 11:22
客气了

实在是不好意思，今天又来麻烦老师您了，老师您在有时间的时候再帮助我，附件再10楼，让您受累了！

longwin · 发表于 2024-6-25 12:16

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$1" Then
  l1 = [b2].End(xlDown).Row
l2 = [b2].End(xlDown).End(xlDown).Row
Range("D" & l1 & ":D" & l2).ClearContents
arr = Range("B" & l1 & ":D" & l2)

n = 1
For i = 1 To UBound(arr) - 1

      If arr(i, 1) > 1 And arr(i + 1, 1) <= 1 Then
         arr(i, 3) = n
         n = 1
      Else
         n = n + 1
      End If
Next
arr(i, 3) = n
Range("B" & l1 & ":D" & l2) = arr
End If
End Sub

cidanji · 发表于 2024-6-25 12:42

LSYYLW · 发表于 2024-6-25 13:03

longwin 发表于 2024-6-25 12:16
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$1" Then
l1 = .End(xl ...

非常感谢老师，代码非常好用，鲜花明天为您献上。

LSYYLW · 发表于 2024-6-25 13:04

cidanji 发表于 2024-6-25 12:42

再次感谢老师，代码非常好用。

LSYYLW · 发表于 2024-6-25 17:37

2024-6-29.zip (12.65 KB, 下载次数: 3)

LSYYLW · 发表于 2024-6-25 17:38

cidanji 发表于 2024-6-25 12:42

抱歉老师，今天又来麻烦老师您了，老师您在有时间的时候再帮助我，附件在16楼，让您受累了！

cidanji · 发表于 2024-6-25 20:28

LSYYLW · 发表于 2024-6-25 21:20

cidanji 发表于 2024-6-25 20:28

万分的感谢老师，代码非常好用。

LSYYLW · 发表于 2024-7-3 12:09

本帖最后由 LSYYLW 于 2024-7-3 21:37 编辑

2024-7-3-2.zip (10.87 KB, 下载次数: 2)

2024-7-3-3.zip (10.76 KB, 下载次数: 2)

2024-7-3-.zip (10.83 KB, 下载次数: 2)

		自动登录	找回密码
密码			免费注册

[已解决] Excel代码问题，非常感谢！

评分

评分

评分