Kann ich eine Tabelle basierend auf einer Spalte in Excel 2007 in mehrere Dateien aufteilen?

Gibt es in Excel eine Möglichkeit, eine große Datei basierend auf dem Inhalt einer einzelnen Spalte in eine Reihe kleinerer Dateien aufzuteilen?

Beispiel: Ich habe eine Datei mit Verkaufsdaten für alle Vertriebsmitarbeiter. Ich muss ihnen eine Datei senden, um Korrekturen vorzunehmen und zurückzusenden, aber ich möchte nicht jedem von ihnen die gesamte Datei senden (weil ich nicht möchte, dass sie die Daten des anderen ändern). Die Datei sieht ungefähr so ​​aus:

salesdata.xls

RepName          Customer        ContactEmail
Adam             Cust1           [email protected]
Adam             Cust2           [email protected]
Bob              Cust3           [email protected]
etc...

davon brauche ich:

salesdata_Adam.xls

RepName          Customer        ContactEmail
Adam             Cust1           [email protected]
Adam             Cust2           [email protected]

und salesdata_Bob.xls

Bob              Cust3           [email protected]

Ist in Excel 2007 etwas integriert, um dies automatisch zu tun, oder sollte ich die VBA ausbrechen?

Soweit ich weiß, gibt es nichts weniger als ein Makro, das Ihre Daten aufteilt und automatisch für Sie in einer Reihe von Dateien speichert. VBA ist wahrscheinlich einfacher.

Update Ich habe meinen Vorschlag umgesetzt. Es durchläuft alle Namen, die im benannten Bereich 'RepList' definiert sind. Der benannte Bereich ist ein dynamischer benannter Bereich der Form = OFFSET (Namen! $ A $ 2,0,0, COUNTA (Namen! $ A: $ A) -1,1)

Modul folgt.

Option Explicit

'Split sales data into separate columns baed on the names defined in
'a Sales Rep List on the 'Names' sheet.
Sub SplitSalesData()
    Dim wb As Workbook
    Dim p As Range

    Application.ScreenUpdating = False

    For Each p In Sheets("Names").Range("RepList")
        Workbooks.Add
        Set wb = ActiveWorkbook
        ThisWorkbook.Activate

        WritePersonToWorkbook wb, p.Value

        wb.SaveAs ThisWorkbook.Path & "\salesdata_" & p.Value
        wb.Close
    Next p
    Application.ScreenUpdating = True
    Set wb = Nothing
End Sub

'Writes all the sales data rows belonging to a Person
'to the first sheet in the named SalesWB.
Sub WritePersonToWorkbook(ByVal SalesWB As Workbook, _
                          ByVal Person As String)
    Dim rw As Range
    Dim personRows As Range     'Stores all of the rows found
                                'containing Person in column 1
    For Each rw In UsedRange.Rows
        If Person = rw.Cells(1, 1) Then
            If personRows Is Nothing Then
                Set personRows = rw
            Else
                Set personRows = Union(personRows, rw)
            End If
        End If
    Next rw

    personRows.Copy SalesWB.Sheets(1).Cells(1, 1)
    Ser personRows = Nothing
End Sub

Diese Arbeitsmappe enthält den Code und den benannten Bereich. Der Code ist Teil des Blattes "Verkaufsdaten".

Für die Nachwelt gibt es hier ein weiteres Makro, um dieses Problem anzugehen.

Dieses Makro durchläuft eine bestimmte Spalte von oben nach unten und wird in eine neue Datei aufgeteilt, wenn ein neuer Wert gefunden wird. Leerzeichen oder wiederholte Werte werden zusammengehalten (sowie die Gesamtzahl der Zeilen), aber Ihre Spaltenwerte müssen sortiert oder eindeutig sein . Ich habe es hauptsächlich für das PivotTables-Layout entworfen (einmal in Werte konvertiert ).

Es ist also nicht erforderlich, den Code zu ändern oder einen benannten Bereich vorzubereiten. Das Makro fordert den Benutzer zunächst auf, die Spalte zu verarbeiten, sowie die Zeilennummer, bei der begonnen werden soll - das heißt, die Überschriften werden übersprungen, und geht von dort aus.

Wenn ein Abschnitt identifiziert wird, anstatt diese Werte auf ein anderes Blatt zu kopieren, wird das gesamte Arbeitsblatt in eine neue Arbeitsmappe kopiert und alle Zeilen unter und über dem Abschnitt werden gelöscht. Auf diese Weise können Sie alle Druckeinstellungen, bedingten Formatierungen, Diagramme oder andere Elemente beibehalten sowie den Header in jeder geteilten Datei beibehalten, was beim Verteilen dieser Dateien hilfreich ist.

Dateien werden in einem \ Split \ -Unterordner mit dem Zellenwert als Dateinamen gespeichert. Ich habe es noch nicht ausführlich an verschiedenen Dokumenten getestet, aber es funktioniert mit meinen Beispieldateien. Probieren Sie es einfach aus und lassen Sie mich wissen, wenn Sie Probleme haben.

Das Makro kann als Excel-Add-In (xlam) gespeichert werden, um eine Schaltfläche auf der Multifunktionsleisten- / Schnellzugriffs-Symbolleistenschaltfläche für den einfachen Zugriff hinzuzufügen.

Public Sub SplitToFiles()

' MACRO SplitToFiles
' Last update: 2019-05-28
' Author: mtone
' Version 1.2
' Description:
' Loops through a specified column, and split each distinct values into a separate file by making a copy and deleting rows below and above
'
' Note: Values in the column should be unique or sorted.
'
' The following cells are ignored when delimiting sections:
' - blank cells, or containing spaces only
' - same value repeated
' - cells containing "total"
'
' Files are saved in a "Split" subfolder from the location of the source workbook, and named after the section name.

Dim osh As Worksheet ' Original sheet
Dim iRow As Long ' Cursors
Dim iCol As Long
Dim iFirstRow As Long ' Constant
Dim iTotalRows As Long ' Constant
Dim iStartRow As Long ' Section delimiters
Dim iStopRow As Long
Dim sSectionName As String ' Section name (and filename)
Dim rCell As Range ' current cell
Dim owb As Workbook ' Original workbook
Dim sFilePath As String ' Constant
Dim iCount As Integer ' # of documents created

iCol = Application.InputBox("Enter the column number used for splitting", "Select column", 2, , , , , 1)
iRow = Application.InputBox("Enter the starting row number (to skip header)", "Select row", 2, , , , , 1)
iFirstRow = iRow

Set osh = Application.ActiveSheet
Set owb = Application.ActiveWorkbook
iTotalRows = osh.UsedRange.Rows.Count
sFilePath = Application.ActiveWorkbook.Path

If Dir(sFilePath + "\Split", vbDirectory) = "" Then
    MkDir sFilePath + "\Split"
End If

'Turn Off Screen Updating  Events
Application.EnableEvents = False
Application.ScreenUpdating = False

Do
    ' Get cell at cursor
    Set rCell = osh.Cells(iRow, iCol)
    sCell = Replace(rCell.Text, " ", "")

    If sCell = "" Or (rCell.Text = sSectionName And iStartRow <> 0) Or InStr(1, rCell.Text, "total", vbTextCompare) <> 0 Then
        ' Skip condition met
    Else
        ' Found new section
        If iStartRow = 0 Then
            ' StartRow delimiter not set, meaning beginning a new section
            sSectionName = rCell.Text
            iStartRow = iRow
        Else
            ' StartRow delimiter set, meaning we reached the end of a section
            iStopRow = iRow - 1

            ' Pass variables to a separate sub to create and save the new worksheet
            CopySheet osh, iFirstRow, iStartRow, iStopRow, iTotalRows, sFilePath, sSectionName, owb.fileFormat
            iCount = iCount + 1

            ' Reset section delimiters
            iStartRow = 0
            iStopRow = 0

            ' Ready to continue loop
            iRow = iRow - 1
        End If
    End If

    ' Continue until last row is reached
    If iRow < iTotalRows Then
            iRow = iRow + 1
    Else
        ' Finished. Save the last section
        iStopRow = iRow
        CopySheet osh, iFirstRow, iStartRow, iStopRow, iTotalRows, sFilePath, sSectionName, owb.fileFormat
        iCount = iCount + 1

        ' Exit
        Exit Do
    End If
Loop

'Turn On Screen Updating  Events
Application.ScreenUpdating = True
Application.EnableEvents = True

MsgBox Str(iCount) + " documents saved in " + sFilePath


End Sub

Public Sub DeleteRows(targetSheet As Worksheet, RowFrom As Long, RowTo As Long)

Dim rngRange As Range
Set rngRange = Range(targetSheet.Cells(RowFrom, 1), targetSheet.Cells(RowTo, 1)).EntireRow
rngRange.Select
rngRange.Delete

End Sub


Public Sub CopySheet(osh As Worksheet, iFirstRow As Long, iStartRow As Long, iStopRow As Long, iTotalRows As Long, sFilePath As String, sSectionName As String, fileFormat As XlFileFormat)
     Dim ash As Worksheet ' Copied sheet
     Dim awb As Workbook ' New workbook

     ' Copy book
     osh.Copy
     Set ash = Application.ActiveSheet

     ' Delete Rows after section
     If iTotalRows > iStopRow Then
         DeleteRows ash, iStopRow + 1, iTotalRows
     End If

     ' Delete Rows before section
     If iStartRow > iFirstRow Then
         DeleteRows ash, iFirstRow, iStartRow - 1
     End If

     ' Select left-topmost cell
     ash.Cells(1, 1).Select

     ' Clean up a few characters to prevent invalid filename
     sSectionName = Replace(sSectionName, "/", " ")
     sSectionName = Replace(sSectionName, "\", " ")
     sSectionName = Replace(sSectionName, ":", " ")
     sSectionName = Replace(sSectionName, "=", " ")
     sSectionName = Replace(sSectionName, "*", " ")
     sSectionName = Replace(sSectionName, ".", " ")
     sSectionName = Replace(sSectionName, "?", " ")
     sSectionName = Strings.Trim(sSectionName)

     ' Save in same format as original workbook
     ash.SaveAs sFilePath + "\Split\" + sSectionName, fileFormat

     ' Close
     Set awb = ash.Parent
     awb.Close SaveChanges:=False
End Sub

Wenn jemand anderes schnell mit der richtigen Vorgehensweise antwortet, ignorieren Sie diese Antwort bitte.

Ich persönlich benutze Excel und verbringe dann viel Zeit (manchmal Stunden) damit, nach einer komplizierten Möglichkeit zu suchen, etwas zu tun, oder nach einer übertriebenen Gleichung, die alles kann, wenn ich es nie wieder verwenden werde ... und es stellt sich heraus, dass Wenn ich mich nur hinsetzte und die Aufgabe manuell erledigte, würde es einen Bruchteil der Zeit dauern.

Wenn Sie nur eine Handvoll Leute haben, empfehle ich Ihnen, einfach alle Daten hervorzuheben, zur Registerkarte Daten zu gehen und auf die Schaltfläche Sortieren zu klicken.

Sie können dann auswählen, nach welcher Spalte sortiert werden soll. In Ihrem Fall möchten Sie Repname verwenden, und dann einfach kopieren und in einzelne Dateien einfügen.

Ich bin mir sicher, dass Sie mit VBA oder anderen Tools möglicherweise eine Lösung finden, aber Tatsache ist, dass Sie sich stundenlang mit der Arbeit beschäftigen werden, wenn Sie mit der oben beschriebenen Methode weitermachen, sollten Sie nebenan fertig sein Keine Zeit.

Ich denke auch, dass Sie so etwas mit Sharepoint + Excel-Diensten tun können, aber das ist eine übertriebene Lösung für diese Art von Dingen.

OK, hier ist der erste Schnitt des VBA. Sie nennen es so:

SplitIntoFiles Range("A1:N1"), Range("A2:N2"), Range("B2"), "Split File - "

Wobei A1: N1 Ihre Kopfzeile (n) ist, A2: N2 die erste Zeile Ihrer Daten ist, B2 die erste Zelle in Ihrer vorsortierten Schlüsselspalte ist. Das letzte Argument ist das Dateinamenpräfix. Der Schlüssel wird vor dem Speichern daran angehängt.

Haftungsausschluss: Dieser Code ist böse.

Option Explicit
Public Sub SplitIntoFiles(headerRange As Range, startRange As Range, keyCell As Range, filenameBase As String)

    ' assume the keyCell column is already sorted


    ' start a new workbook
    Dim wb As Workbook
    Dim ws As Worksheet

    Set wb = Application.Workbooks.Add
    Set ws = wb.ActiveSheet

    Dim destRange As Range
    Set destRange = ws.Range("A1")

    ' copy header
    headerRange.Copy destRange
    Set destRange = destRange.Offset(headerRange.Rows.Count)

    Dim keyValue As Variant
    keyValue = ""

    While keyCell.Value <> ""

        ' if we've got a new key, save the file and start a new one
        If (keyValue <> keyCell.Value) Then
        If keyValue <> "" Then
            'TODO: remove non-filename chars from keyValue
            wb.SaveAs filenameBase & CStr(keyValue)
            wb.Close False
            Set wb = Application.Workbooks.Add
            Set ws = wb.ActiveSheet
            Set destRange = ws.Range("A1")

            ' copy header
            headerRange.Copy destRange
            Set destRange = destRange.Offset(headerRange.Rows.Count)

            End If
        End If

        keyValue = keyCell.Value

        ' copy the contents of this row to the new sheet
        startRange.Copy destRange

        Set keyCell = keyCell.Offset(1)
        Set destRange = destRange.Offset(1)
        Set startRange = startRange.Offset(1)
    Wend

    ' save residual
    'TODO: remove non-filename chars from keyValue
    wb.SaveAs filenameBase & CStr(keyValue)
    wb.Close

End Sub

Ich sortiere nach Namen und füge die Informationen direkt in eine zweite Excel-Tabelle ein, die Sie versenden möchten. Excel fügt nur die angezeigten Zeilen ein, nicht auch die ausgeblendeten Zeilen. Ich schütze auch alle Zellen mit Ausnahme der Zellen, die aktualisiert werden sollen. lol.