求助自动填充的VBA代码。

gxggxy103

如图的一个excel工作表。

要求：
组号 的值不固定，但有数值限制，比如1-56，设想在 组号 列的任意单元格输入数值，此单元格后续的组号增加1（比如：组号 列的任意一个单元格G2输入20，则G3单元格自动填充为21，G4为22……，但当G列自动填充到此列最后一个单元格时，组号 列就顺序显示在L列了。）

gxggxy103

最好能自由增加行数。先谢谢大神们了！

gxggxy103

表格最好能够自由增加行数。

先谢谢大神们了！

ykcbf1100

先标记一下。

准提部林

Dim Chk%

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xA As Range, N%
With Target
     If Chk = 1 Or .Count > 1 Or .Row < 2 Or .Row > 15 Then Exit Sub
     If Cells(1, .Column) <> "組號" Then Exit Sub
     Set xA = .Cells(2, 1): N = (.Value - 1) Mod 56 + 1
     If N = 0 Then Exit Sub
     Chk = 1
     Do
        N = N Mod 56 + 1: xA = N:  Set xA = xA(2)
        If xA.Row > 15 Then Set xA = xA(-13, 6)
        If xA.Row = 2 Then If xA(0) <> "組號" Then Exit Do
     Loop
     Chk = 0
End With
End Sub

准提部林

"組號" -- 自行更改為簡體

gxggxy103

准提部林 发表于 2024-2-5 16:21
Dim Chk%

Private Sub Worksheet_Change(ByVal Target As Range)

大侠可以在在下发的附件里搞一下吗？鞠躬致谢！

gxggxy103

准提部林 发表于 2024-2-5 16:21
Dim Chk%

Private Sub Worksheet_Change(ByVal Target As Range)

当自动填充到“组号”最后一列的最后一个单元格，1-56剩余的数值无法继续填充“组号”的第一列，即B列。
比如：在Q14单元格输入1，则Q15单元格显示为2，按要求，B2单元格应显示3才对，下面同列的单元格顺序显示。但目前只能显示到Q15单元格。如果要是在Q15单元格输入数值1，显示的就更奇怪了，如图：


请大神完善。鞠躬致谢。

gwjkkkkk

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ar, i&, j&, iCol&, iRow&, iNum&
   
    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, [A1].CurrentRegion) Is Nothing Then Exit Sub
   
    iCol = Target.Column
    iRow = Target.Row
    iNum = Target.Value
    If Cells(1, iCol).Value = "组号" Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
         With [A1].CurrentRegion
             ar = .Value
             For i = 2 To UBound(ar)
                 If i > iRow Then
                      iNum = iNum + 1
                       iNum = IIf(iNum Mod 56 = 0, 56, iNum Mod 56)
                      .Cells(i, iCol).Value = iNum
                 End If
             Next i
             For j = iCol + 5 To UBound(ar, 2) Step 5
                 For i = 2 To UBound(ar)
                      iNum = iNum + 1
                      iNum = IIf(iNum Mod 56 = 0, 56, iNum Mod 56)
                      .Cells(i, j).Value = iNum
                 Next i
             Next j
         End With
         Application.EnableEvents = True
         Application.ScreenUpdating = True
    End If
End Sub

gwjkkkkk

请参考、、、