0

SAP からエクスポートされるデータからのグループの作成を自動化するスクリプトを作成しようとしています。そのため、最初の列に次のようなデータが表示され、次の列に部品番号と説明が表示されます。

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

などなど1、最高レベルと4最低の原材料レベルで、各サブレベルの 1 つまたは数百が存在する可能性があります。たった 1 回のエクスポートで 2,000 ～ 5,000 個のコンポーネントが含まれるため、すべてを手動でグループ化することから始めるのは非常に面倒なプロセスです。だから私はこれを自動化しようとしてきましたが、壁にぶつかり続けています。私のコードはめちゃくちゃで、実際には何もしませんが、私が行ったことを投稿します。

    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

1構造がある場合とない場合があるため、最初に各トップレベルと次のレベルの間の長さを見つけようとしています。次に、その 1 つの「グループ」内で同じことを行い、2次にグループ化を行い、最後に列の残りをループして、各「1 対 1」グループで同じことを行います。これが正しい方法なのか、それとも可能なのかはわかりませんが、どこかから始めなければなりませんでした。34

エクスポートされるものの例を次に示します。

SO19009523 最初の質問例

私が探しているグループ化の例を次に示します。

SO19009523 2 番目の質問の例

4

1 に答える 1

0

このコードを試してください：

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
于 2013-09-25T18:04:45.413 に答える