每若干行定义标签

Ericcccccc

每6行标记为x组，其中不满6个的也算1组，请问代码如何实现？

ykcbf1100

附件供参考。。。

3190496160

Sub 分组()
r = Cells(Rows.Count, 1).End(xlUp).Row
ar = Range("a1:b" & r)
For i = 1 To UBound(ar) Step 6
    m = m + 1
    For s = i To i + 5
        If s <= UBound(ar) Then
            ar(s, 2) = m & "组"
        End If
    Next s
Next i
Range("a1:b" & r) = ar
End Sub

3190496160

Ericcccccc

3190496160 发表于 2023-4-3 15:56

追问一下，如果把每组分别拆分到新建的sheet，代码怎么调整

3190496160

Ericcccccc 发表于 2023-4-3 15:58
追问一下，如果把每组分别拆分到新建的sheet，代码怎么调整

论坛是做义务的，所以，一次性把自己的需求说清楚很重要，不要挤牙膏似的提问

Ericcccccc

ykcbf1100 发表于 2023-4-3 15:53
附件供参考。。。

感谢~
追问一下，如果把每组分别拆分到新建的sheet，代码怎么调整

3190496160

Sub 分组()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each sh In Sheets
    If sh.Index > 1 Then
        sh.Delete
    End If
Next sh
Application.DisplayAlerts = True
r = Cells(Rows.Count, 1).End(xlUp).Row
ar = Range("a1:b" & r)
For i = 1 To UBound(ar) Step 6
    m = m + 1
    n = 0
    ReDim br(1 To 6, 1 To 2)
    For s = i To i + 5
        If s <= UBound(ar) Then
            ar(s, 2) = m & "组"
            n = n + 1
            For j = 1 To 2
                br(n, j) = ar(s, j)
            Next j
        End If
    Next s
    If n > 0 Then
        Set sht = Sheets.Add(after:=Sheets(Sheets.Count))
        sht.Name = m & "组"
        sht.[a1].Resize(n, 2) = br
    End If
Next i
Sheet1.Range("a1:b" & r) = ar
Application.ScreenUpdating = True
End Sub

3190496160

每6个分组.rar (19.67 KB, 下载次数: 0)

2023-4-3 16:11 上传

点击文件名下载附件

ykcbf1100

Ericcccccc 发表于 2023-4-3 16:00
感谢~
追问一下，如果把每组分别拆分到新建的sheet，代码怎么调整

拆分为多表。