[已解决]求一个自动编号的问题

无聊的疯子

回复 syt188702 的帖子

附件中代码太多重复无用的代码,影响速度!对于是一个连续的区域,可以向上面一样使用数组,把数据先写进数组,然后再一次写进单元格,这样就可以提速度!!

另外本贴附件中的数据既然是要求说明问题的,那你的数据就不能太水了,就是水也应该说明一下,不然会让人很郁闷的!!

无聊的疯子

syt188702 发表于 2011-9-16 19:14
回老师，附件传上，录入表录数据，数据表B接收数据A产生自动编号（固定位数）

代码放在Change事件中

功能说明:
  1,第二行为初始行,也就是说必需先对对2行输入内容,以下功能才能实现(初始序号1887020002)
  2,代码支持隔行输入,即在第二行输入后,可以在第5行输入 序号为(1887020003)
  3,隔行输入后,在中间的空行输入内容,会自动更新下面的序号,比如说在第4行输入内容,序号昌(1887020003),那第5行的序号会更新成最后一个(1887020004)

1. 
   
2. Private Sub Worksheet_Change(ByVal Target As Range)
   
3.     If Target.Count = 1 And Target.Column = 2 Then
   
4.         If Target.Row = 2 Then
   
5.             Target.Offset(, -1).Value = 1887020002      '设定初始值
   
6.         ElseIf Target.Row > 2 And Target.Value <> "" Then
   
7.             k = Target.Offset(, -1).End(xlUp).Value + 1 '记录当前需要定入的值
   
8.             Target.Offset(, -1).Value = k       '将序号写入对应的行
   
9.             If Target.Row <> Range("a65536").End(xlUp).Row Then     '如果当前操作的行下面还有内容,就需要对下面的内容进行重写
   
10.                 For X = Target.Row + 1 To Range("a65536").End(xlUp).Row     '从当前行 循环到最后一行
    
11.                     If Cells(X, 1) <> "" Then Cells(X, 1) = k + 1: k = k + 1    '如果不为空,就写入新的序号
    
12.                 Next
    
13.             End If
    
14.         End If
    
15.     End If
    
16. End Sub
    

复制代码

syt188702

回复 无聊的疯子 的帖子

谢谢老师解难

syt188702

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Count = 2 And Target.Column = 3 Then
   
3.         If Target.Row = 2 Then
   
4.             Target.Offset(, -1).Value = 1887020001      '设定初始值
   
5.         ElseIf Target.Row > 2 And Target.Value <> "" Then
   
6.             k = Target.Offset(, -1).End(xlUp).Value + 1 '记录当前需要定入的值
   
7.             Target.Offset(, -1).Value = k       '将序号写入对应的行
   
8.             If Target.Row <> Range("b65536").End(xlUp).Row Then     '如果当前操作的行下面还有内容,就需要对下面的内容进行重写
   
9.                 For X = Target.Row + 1 To Range("b65536").End(xlUp).Row     '从当前行 循环到最后一行
   
10.                     If Cells(X, 1) <> "" Then Cells(X, 1) = k + 1: k = k + 1    '如果不为空,就写入新的序号
    
11.                 Next
    
12.             End If
    
13.         End If
    
14.     End If
    
15. End Sub

复制代码

请问老师，我把代码改了一下，3列有数据，2列填充编号，不产生效果，错在那里，谢谢

无聊的疯子

回复 syt188702 的帖子

内容2. If Target.Count = 2这个的意思是选择的单元格是2个单元格。

由于我们都只能对一个单元格操作!所以2. If Target.Count = 1   才行

zyjs029

学习了

syt188702

回复 无聊的疯子 的帖子

谢谢老师的多次解难，受益不少，老师晚了注意休息，谢谢

杨帆远航

学习了,不错的

sz81101099

高手啊，学习了

aagen

路过。。。一起学习