怎么让excel按序号自动分组【已解决】

liulang0808

你看看附件吧，不知道是否理解的到位

feng1989

yjh_27 发表于 2014-2-27 11:57
你的系统不让用宏，你继续手动吧。

代码如下：

已下载，非常感谢！

feng1989

liulang0808 发表于 2014-2-27 12:05
你看看附件吧，不知道是否理解的到位

应该是我表达不好，是按楼上 yjh-27 那位来的，已解决，谢谢了！

64968650

yjh_27 发表于 2014-2-27 11:57
你的系统不让用宏，你继续手动吧。

代码如下：

这个代码是以序号内有.来做的，我这里有个问题想请教一下老师,我表里是按
1   1  2  3  4  5  6  7
2   1 2 3  4 5 6 7 8 9 10 11 12
3   1 2 3 4 5 6 7 8 9
4   1 2 3 4 5 6 7
这样子的顺序来排序的，可否有代码进行分组？
可见贴子：
http://club.excelhome.net/thread-1233500-1-1.html

yjh_27

64968650 发表于 2015-10-5 18:07
这个代码是以序号内有.来做的，我这里有个问题想请教一下老师,我表里是按
1   1  2  3  4  5  6  7
2   ...

根据h列设置 . 即可：

1. For i = 2 To UBound(arr)
   
2.         If Right(arr(i, 8), 2) = "00" Then
   
3.             arr(i, 1) = "."
   
4.         else
   
5.             arr(i, 1) = ".."
   
6.         End If
   
7.     Next

复制代码

再套用

64968650

结果提示类型不匹配,想将这些序号进行自动分组

mingleung

Private Sub GroupButton_Click(sender As Object, e As RibbonControlEventArgs) Handles GroupButton.Click
        Dim ows As Excel.Worksheet
        Dim owr As Excel.Range
        Dim orow As Excel.Range
        Dim orowrange As Excel.Range
        Dim ntime As Int16
        ntime = 0
        Dim nrowlen As Int16
        Dim crow As String
        owr = Globals.ThisAddIn.Application.Selection.rows
        ows = Globals.ThisAddIn.Application.ActiveWorkbook.ActiveSheet
        owr.ClearOutline()
        ows.Outline.SummaryRow = Microsoft.Office.Interop.Excel.XlSummaryRow.xlSummaryAbove
        For Each orow In owr
            crow = orow.Value
            nrowlen = Len(crow)

            If nrowlen <= 1 Then
                ntime = 1 + ntime
                If ntime > 1 Then
                    orowrange.Select()
                    orowrange.Rows.Group()
                End If
                If nrowlen = 0 Then Exit For
                orowrange = Nothing
            Else
                If IsNothing(orowrange) Then
                    orowrange = orow
                Else
                    orowrange = Globals.ThisAddIn.Application.Union(orow, orowrange）
                End If
            End If
            Diagnostics.Debug.Print(crow)
        Next


    End Sub