根据单元格是否有内容进行序列编号。

pnwzj

总行数不固定，标题占2行。
如图所示，求vba方式实现，在A列根据d列对应单元格是否有内容而1-N自动编号。多谢。

microyip

公式就解决问题啦，这个不需要VBA吧？

eqzh

A3=IF(D3<>"",COUNTA($D$3:D3),"")，下拉

lsc900707

1. Sub gj23w98()
   
2.     r = Cells(Rows.Count, 4).End(3).Row
   
3.     arr = Range("a1:d" & r)
   
4.     For i = 3 To UBound(arr)
   
5.         If Len(arr(i, 4)) > 0 Then
   
6.             m = m + 1
   
7.             arr(i, 1) = m
   
8.         End If
   
9.     Next
   
10.     Range("a1:d" & r) = arr
    
11. End Sub

复制代码

pnwzj

lsc900707 发表于 2019-6-14 22:46

还没试，先送分！感谢。

网海遨游

sub test()
r=[c65536].end(3).row
for each rng in range("c3:c" & r)
if rng<>"" then
n=n+1
cells(rng.row,1)=n
endif
next rng
end sub

gxp1986

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim n As Integer, i As Integer, j As Integer, tr As Integer, tl As Integer, lr As Integer, k As Integer
   
3.     n = Target.Count
   
4.     If n > 1000 Then Exit Sub
   
5.     Application.ScreenUpdating = False
   
6.         For i = 1 To n
   
7.             tr = Target.Cells(i).Row
   
8.             tl = Target.Cells(i).Column
   
9.             If tr > 2 Then
   
10.                 If tl = 4 Then
    
11.                     Range("a3:a10000") = ""
    
12.                     lr = Cells(10000, 4).End(xlUp).Row
    
13.                     k = 0
    
14.                     For j = 3 To lr
    
15.                         If Cells(j, 4) <> "" Then
    
16.                             k = k + 1
    
17.                             Cells(j, 1) = k
    
18.                         End If
    
19.                     Next
    
20.                 End If
    
21.             End If
    
22.         Next
    
23.     Application.ScreenUpdating = True
    
24. End Sub

复制代码