Mit VBA eine Excel-Datei splitten

3 Antworten

Was ist denn deine Frage? Ob das möglich ist? → Ja, das ist möglich.

Du kannst es direkt aus Excel heraus machen oder als VBS-Datei. Du kannst auch Excel-Dokumente mit SQL auslesen.

Habe hier leider nur Excel Starter, aber sei dir schon einmal versichert, dass es geht. Also du wirst nicht umsonst anfangen, dich in die Thematik einzuarbeiten.
Mache dich am besten mit Grundkonzepten von Programmiersprachen (Abfrage, Schleifen, Variablen,...) als erstes vertraut, dann mit dem Objektmodell von Excel.

Danke für deine Antwort. Im Optimalfall bin ich auf der Suche nach einer Beispieldatei oder einem Beispiel Code, den ich verwenden möchte. Im Gründe soll der Code für jede unterschiedliche Angabe in Spalte A (dort steht der Projektname) eine eigene Datei erzeugen. Ein anderer Code soll diese erzeugten Dateien dann wiederzu einer Datei zusammenfassen.

Danke vorab, Torsten

0
@torstenkr

Ich kann dir ja mal ein paar Ansätze für eine Lösung mittels eines Scriptfiles geben. Speichere es als .vbs Datei ab:

' Lesen aus einer Exceldatei mittels SQL
Sub TestExcelSQL
    sSql = "select Artikel, VK from rangeArtikelpreise"
    Set oResultSet = db_ExecuteQuery(sSql, "DSN=Test Excel 1")
    oResultSet.MoveFirst
    sAusgabe = sAusgabe & "Excel" & vbcrlf & "-----" & vbcrlf & "Artikel" & vbtab & "VK" & vbcrlf
    Do While Not oResultSet.eof
        sAusgabe = sAusgabe & oResultSet("Artikel") & vbtab & oResultSet("VK") & vbcrlf
        oResultSet.MoveNext
    Loop
    sAusgabe = sAusgabe & vbcrlf
End Sub

' Schreiben einer Exceldatei
Sub TestExcelSchreiben()
    sExceldatei = "C:\temp\exceldatei.xlsx"
    Set oExcel = CreateObject("Excel.Application")

    oExcel.Visible = True
    oExcel.Workbooks.add
    oExcel.Cells(1, 1).Value = "Testeintrag"
    oExcel.ActiveWorkbook.SaveAs(sExceldatei)
    oExcel.Quit
End Sub

' Hilfsfunktion zum Lesen aus einer Exceldatei mittels SQL
Function db_ExecuteQuery(sSelect, sDSN)
    On Error Resume Next
    if oConnection.State <> 0 then _
        oConnection.Close
    oConnection.Open sDSN
    db_ExecuteQuery.Close
    Set db_ExecuteQuery = oConnection.Execute(sSelect)
End Function

Ich hoffe, nichts Wesentliches vergessen zu haben. Der Code ist schon etwas älter.

0

Hey Torsten,

sowas würde ich eher mit einer Zugangskontrolle machen. Bedeutet wenn sich die Datei öffnet gibt es eine Starttabelle wo nur ein Login und Schliessen Button ist.

Dann kann sich der Projektleiter mit Name und Passwort einloggen und sieht nur seine Tabelle, dafür braucht jedes Projekt sein eigenes Tabellenblatt.

Da du wahrscheinlich eine große Datei hast wo alles auf einem Tabellenblatt ist würde ich erstmal für jedes Projekt ein eigenes Tabellenblatt erstellen. Danach können dann die Projektleiter ihre Daten immer sebst bearbeiten und abspeichern.

Wäre das was für dich?

Ich gehe davon aus, dass sich deine User bei Windows anmelden müssen.

Diesen Anmeldenamen schreibst du hinter alle Daten in eine neue Spalte jeweils für jeden Datensatz ein.

Bei mir ist das im Beispiel Spalte 8 = "H"

Du gehst mit Alt F11 in den Makroeditor.

Dort wählst (Doppelklick!) du oben links "Diese Arbeitsmappe"

Rechts setzt du dann folgenden Code ein:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim lngLastRow As Long
Dim objWB As Workbook

Sheets("Tabelle1").Unprotect ("MeinPasswort")
lngLastRow = Sheets("Tabelle1").Range("H:H").SpecialCells(xlCellTypeLastCell).Row 'xlCellTypeLastCell xlCellTypeBlanks

Sheets("Tabelle1").Range("A1:H" & lngLastRow).Locked = True
Sheets("Tabelle1").Range("A1:H" & lngLastRow).FormulaHidden = True
Sheets("Tabelle1").Range("A1:H" & lngLastRow).EntireRow.Hidden = True
For Each objWB In Application.Workbooks
    objWB.Save
Next objWB
Application.Quit
End Sub

Private Sub Workbook_Open()
Dim lngLastRow As Long
Dim I As Long

ActiveSheet.Unprotect ("MeinPasswort")
lngLastRow = Sheets("Tabelle1").Range("H:H").SpecialCells(xlCellTypeLastCell).Row 'xlCellTypeLastCell xlCellTypeBlanks

Sheets("Tabelle1").Range("A1:H" & lngLastRow).Locked = True
Sheets("Tabelle1").Range("A1:H" & lngLastRow).FormulaHidden = True
Sheets("Tabelle1").Range("A1:H" & lngLastRow).EntireRow.Hidden = True

For I = lngLastRow To 2 Step -1
    'Abfrage , ob in Spalte 8 (H) der Name steht
    If Cells(I, 8) = Environ("Username") Then
        Sheets("Tabelle1").Rows(I).EntireRow.Hidden = False
        Sheets("Tabelle1").Rows(I).Locked = False
        Sheets("Tabelle1").Rows(I).FormulaHidden = False
    End If
Next I
ActiveSheet.Protect ("MeinPasswort"), DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Mein Passwort musst du natürlich anpassen.

Damit die User deinen Code nicht sehen können nun noch ein paaar Schritte:

Geh mit einem Rechtsklick auf "Diese Arbeitsmappe"

Wähle "Eigenschaften von VBA:Projekt"

Wähle Registerkarte "Schutz"

Sperre das Projekt und vergib ein Kennwort

Dieses Beispiel braucht keine Einzeldateien pro Projekt, die dann wieder zusammenkopiert werden (Redundanz), es kommt mit einem Datensatz aus.

Die Testdatenbank - (Excel, VBA)

Klasse! DH!

0

Was möchtest Du wissen?