自动创建组 [英] Automating group creation

问题描述

我正在尝试编写一个脚本，以便从从SAP导出的数据中自动创建组。因此，数据在第一列中列出如下，部分号码和描述如下。

  .1 
 ..2 
 ..2 
 ... 3 
 .... 4 
 .1 
 .1 
 ..2 
  

等等，其中 1 是最高的级别和 4 最低原材料级别可以是每个子级别中的每一个或数百个之一。只有一个出口有2,000-5,000个组件，所以这是一个非常繁琐的过程，从手动分组一切。所以我一直在尝试自动化，但是一直跑到墙上。我的代码是一团糟，除了我会发布我所做的一切以外，我没有任何事情。

  Dim myRange As范围
 Dim rowCount As Integer，currentRow As Integer 
 Dim GrpRange As Range，GrpStart As Integer，GrpEnd As Integer，GrpCount As Integer 
 Dim GrpLoop As Integer，GrpLoopEnd As Integer，GrpLoopEndRow As Integer 
 Dim GrpSt As Integer 
 
 GrpSt = 2 
 GrpStart = 2 
 GrpEnd = RowEnd（2，1）
 GrpLoopEnd = 100 
 
'循环遍历每个组
'对于TotalLoop = 2 To GrpEnd 
 
'确定1到1行长度
对于GrpStart = GrpSt到GrpEnd 
单元格（GrpStart ，1）。选择
如果右（ActiveCell，1）= 1然后
 GrpSt = ActiveCell.Row 
对于GrpLoop = 0到GrpLoopEnd 
如果右（Cells（GrpSt，1 ），1）= 1然后
 GrpLoopEnd = 1 
 GrpLoopEndRow = ActiveCell.Row 
退出
结束如果
 Next 
 End If 
 
 Next GrpStart 
  

我是第一个只是试图找到每个顶级 1 和下一个之间的长度，因为有时有结构，有时不是。接下来，我将为 2 然后 3 然后 4 在一个组中，然后进行分组，最后循环遍历列的其余部分，并对每个1到1组执行相同操作。我不知道这是否是正确的方式，甚至可能，但是我必须从某个地方开始。

以下是导出内容的示例：

以下是我正在寻找的分组示例：

解决方案

尝试此代码：

  Sub AutoOutline_Characters（）
 Dim intIndent As Long，lRowLoop2 As Long，lRowStart As Long 
 Dim lLastRow As Long，lRowLoop As Long 
 Const sCharacter As String =。 
 
 application.ScreenUpdating = False 
 
单元格（1，1）.CurrentRegion.ClearOutline 
 
 lLastRow =单元格（Rows.Count，1）。结束（xlUp）.Row 
 
 With ActiveSheet.Outline 
 .AutomaticStyles = False 
 .SummaryRow = xlAbove 
 .SummaryColumn = xlRight 
 End with 
 
对于lRowLoop = 2 To lLastRow 
 
 intIndent = IndentCalc（Cells（lRowLoop，1）.Text，sCharacter）
 
如果IndentCalc（Cells（lRowLoop + 1，A），sCharacter）< = intIndent然后GoTo nxtCl：
 
对于lRowLoop2 = lRowLoop + 1 To lLastRow'为我们当前单元格下面的所有行
 
如果IndentCalc（Cells（lRowLoop2 + 1，A），sCharacter）< = intIndent和lRowLoop2> lRowLoop + 1然后'如果遇到更高的维度
如果lRowLoop2> lRowLoop + 1 Then Rows（lRowLoop + 1&：& lRowLoop2）.Group 
 GoTo nxtCl 
 End If 
 
 Next lRowLoop2 
 
 nxtCl：
 
下一个lRowLoop 
 
 application.ScreenUpdating = True 
 
 End Sub 
 
函数IndentCalc（sString As String， （sString）
如果Mid > sCharacter Then 
 IndentCalc = lCharLoop  -  1 
退出函数
结束如果
下一个
 
结束函数
  / pre> 
I'm trying to write a script to automate creating groups from data being exported from SAP. So the data comes out as follows in the first column with part numbers and descriptions in the following ones.
.1
..2
..2
...3
....4
.1
.1
..2
and so on and so forth with 1 being the highest level and 4 the lowest raw material level there can be one of each or hundreds of each sub-level. Just one export has 2,000-5,000 components so it's a very tedious process starting out with grouping everything manually. So I've been trying to automate this but keep running into walls. My code is a mess and doesn't really do anything but I'll post what I've done.
    Dim myRange As Range
    Dim rowCount As Integer, currentRow As Integer
    Dim GrpRange As Range, GrpStart As Integer, GrpEnd As Integer, GrpCount As Integer
    Dim GrpLoop As Integer, GrpLoopEnd As Integer, GrpLoopEndRow As Integer 
    Dim GrpSt As Integer

GrpSt = 2
GrpStart = 2
GrpEnd = RowEnd(2, 1)
GrpLoopEnd = 100

'Loop through each group
  'For TotalLoop = 2 To GrpEnd

'Determine 1 to 1 row length
For GrpStart = GrpSt To GrpEnd
    Cells(GrpStart, 1).Select
    If Right(ActiveCell, 1) = 1 Then
        GrpSt = ActiveCell.Row
        For GrpLoop = 0 To GrpLoopEnd
            If Right(Cells(GrpSt, 1), 1) = 1 Then
                GrpLoopEnd = 1
                GrpLoopEndRow = ActiveCell.Row
                Exit For
            End If
        Next
    End If

Next GrpStart
I'm first just trying to find the length between each top level 1 and the next one, because sometimes there is structure and sometimes not. Next I was going to do the same for the 2 then 3 then 4 within that one "group", then do the grouping and finally loop through the rest of the column and do the same with each "1 to 1" group. I'm not sure if this is the right way or even possible but I had to start from somewhere.

Here's an example of what is exported:



Here's an example of the grouping I'm looking for:

解决方案
Try this code: 
Sub AutoOutline_Characters()
Dim intIndent As Long, lRowLoop2 As Long, lRowStart As Long
Dim lLastRow As Long, lRowLoop As Long
Const sCharacter As String = "."

application.ScreenUpdating = False

Cells(1, 1).CurrentRegion.ClearOutline

lLastRow = Cells(Rows.Count, 1).End(xlUp).Row

With ActiveSheet.Outline
    .AutomaticStyles = False
    .SummaryRow = xlAbove
    .SummaryColumn = xlRight
End With

For lRowLoop = 2 To lLastRow

    intIndent = IndentCalc(Cells(lRowLoop, 1).Text, sCharacter)

    If IndentCalc(Cells(lRowLoop + 1, "A"), sCharacter) <= intIndent Then GoTo nxtCl:

    For lRowLoop2 = lRowLoop + 1 To lLastRow 'for all rows below our current cell

        If IndentCalc(Cells(lRowLoop2 + 1, "A"), sCharacter) <= intIndent And lRowLoop2 > lRowLoop + 1 Then 'if a higher dimension is encountered
            If lRowLoop2 > lRowLoop + 1 Then Rows(lRowLoop + 1 & ":" & lRowLoop2).Group
            GoTo nxtCl
        End If

    Next lRowLoop2

nxtCl:

Next lRowLoop

application.ScreenUpdating = True

End Sub

Function IndentCalc(sString As String, Optional sCharacter As String = " ") As Long
Dim lCharLoop As Long

For lCharLoop = 1 To Len(sString)
    If Mid(sString, lCharLoop, 1) <> sCharacter Then
        IndentCalc = lCharLoop - 1
        Exit Function
    End If
Next

End Function


                        
这篇关于自动创建组的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！