Hot News:

Unser Angebot:

  Foren auf CAD.de (alle Foren)
  Excel
  Makros kombinieren

Antwort erstellen  Neues Thema erstellen
CAD.de Login | Logout | Profil | Profil bearbeiten | Registrieren | Voreinstellungen | Hilfe | Suchen

Anzeige:

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen nächster neuer Beitrag | nächster älterer Beitrag
Autor Thema:  Makros kombinieren (2210 mal gelesen)
Darksidy
Mitglied
Controller


Sehen Sie sich das Profil von Darksidy an!   Senden Sie eine Private Message an Darksidy  Schreiben Sie einen Gästebucheintrag für Darksidy

Beiträge: 16
Registriert: 29.05.2013

erstellt am: 26. Sep. 2013 11:26    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo zusammen

Ich habe hier zwei Makros, die ich gerne kombinieren würde.
Makro 1 öffnet .csv-Files, sollte dann Makro 2 ausführen, das File als .xls abspeichern, schliessen und durch den Loop sollten alle .csv-Dateien im Verzeichnis so bearbeitet werden.

Makro 2 nimmt Formatierungen an den .csv-Files vor.

Ich kann diese Makros mit Call-Funktion nicht kombinieren... Wichtig zu erwähnen ist: Makro 1 (ohne Makro 2 auszuführen) funktioniert! Makro 2 an sich funktioniert ebenso. Ich möchte jedoch, dass ich sämtliche csv-Files (das sind ca. 900) mit einem Knopfdruck bearbeitet und als .xls abgespeichert habe.

Der Code für Makro 1 lautet:

Code:
Sub ALausführen()
Dim strVerzeichnis As String
  Dim strDatei As String
  Dim strTyp As String
  Dim strDateiname As String
  strTyp = "*.csv"
  Application.ScreenUpdating = False
  strVerzeichnis = "\\MEIN-VERZEICHNIS\"
  strDateiname = Dir(strVerzeichnis & strTyp)
  Do While strDateiname <> ""
      Workbooks.Open Filename:=strVerzeichnis & strDateiname
      'hier "DeinMakro" eingeben oder mit command "call" das Makro ausführen (Das funktioniert jedoch nicht)
      ActiveWorkbook.SaveCopyAs Application.Substitute(strDateiname, ".csv", "") & ".xls"
      ActiveWorkbook.Close
    strDateiname = Dir
  Loop
  Application.ScreenUpdating = True
End Sub


Der Code zum zweiten Makro lautet:

Code:
Public DatenQuelle As String 'Name der Statistik
Public s As String 'Tabellenblatt für die Statistiken
Public Drucken As Boolean 'Wird für die Sofort-Druck Funktion benötigt

Sub Start()
   
    DatenQuelle = ActiveWorkbook.ActiveSheet.Name
    s = "Statistiken"
   
    If StatistikOffenKontrolle(s) = True Then
        Sheets("Statistiken").Activate
        Exit Sub
    End If
   
    If StatistikKontrolle = False Then
        MsgBox ("Keine Statistik geöffnet!")
        Exit Sub
    End If
   
    NeueArbeitsmappe

End Sub

Sub StartAndPrint()
   
    DatenQuelle = ActiveWorkbook.ActiveSheet.Name
    s = "Statistiken"
   
    If StatistikOffenKontrolle(s) = True Then
        With Sheets("Statistiken")
        .Activate
        .PrintOut
        End With
        Exit Sub
    End If
   
    If StatistikKontrolle = False Then
        MsgBox ("Keine Statistik geöffnet!")
        Exit Sub
    End If
   
    Drucken = True
   
    NeueArbeitsmappe

End Sub


Sub NeueArbeitsmappe()

    Worksheets.Add(Sheets(1)).Name = "Statistiken"


    Worksheets("Statistiken").Activate
   
   

    TitelUndTexteEinlesenUndSchreiben

End Sub

Sub FormatierungenAnpassen()
   
    'Ganzzahlen & Tausender-Trennzeichen
    Sheets(s).Range("B2:N2").NumberFormat = "#,##0" 'Umsatz
    Sheets(s).Range("B3:N3").NumberFormat = "#,##0" 'Umsatz 2010
    Sheets(s).Range("B4:N4").NumberFormat = "#,##0" 'Umsatz 2009
    Sheets(s).Range("B5:N5").NumberFormat = "#,##0" 'Warenaufwand
    Sheets(s).Range("B7:N7").NumberFormat = "#,##0" 'Laufmeterumsatz
    Sheets(s).Range("B8:N8").NumberFormat = "#,##0" 'Laufmeter Umsatz Vgl Standort
    Sheets(s).Range("B10:N10").NumberFormat = "#,##0" 'Absatz
    Sheets(s).Range("B13:N13").NumberFormat = "#,##0" 'Lagerwert (OFP)
    Sheets(s).Range("B16:N16").NumberFormat = "#,##0" 'Einkauf OFP
   
    Sheets(s).Range("B18:N18").NumberFormat = "#,##0" 'Abschreibungen
    Sheets(s).Range("B19:N19").NumberFormat = "#,##0" 'Inventurdifferenzen
    Sheets(s).Range("B21:N21").NumberFormat = "#,##0" 'Kundenbestellungen
    Sheets(s).Range("B22:N22").NumberFormat = "#,##0" 'Remission
       
    '2 Kommastellen & Tausender-Trennzeichen
    Sheets(s).Range("B11:N11").NumberFormat = "#,##0.00" 'Ø Preis
    Sheets(s).Range("B14:N14").NumberFormat = "#,##0.00" 'Lagerumschlagshäufigkeit
    Sheets(s).Range("B15:N15").NumberFormat = "#,##0.00" 'Lagerumschlagshäufigkeit Vgl Standort
   
    'Prozent, auf eine Stelle gerundet
    Sheets(s).Range("B6:N6").NumberFormat = "0.0%" 'Bruttogewinnmarge in % vom Umsatz)
    Sheets(s).Range("B20:N20").NumberFormat = "0.0%" 'Marge 2
   
    Sheets(s).Range("B45:B54").NumberFormat = "#,##0" 'Rankings
    Sheets(s).Range("O18:O22").NumberFormat = "0.00%" 'Durchschnittswerte
   
    'Prozent, ohne Dezimalstellen
    Sheets(s).Range("P2:P3").NumberFormat = "0%" 'Mt. VJ
   
    'Prozent, ohne Dezimalstellen
    Sheets(s).Range("O2:O3").NumberFormat = "0%" 'Delta Umsatz
   
    Layout

End Sub


Sub TitelUndTexteEinlesenUndSchreiben()
   
    Dim Daten(18) As String
    Dim ZeilenCounter As Integer

    ZeilenCounter = 1

    For e = 0 To 18
    Daten(e) = Sheets(DatenQuelle).Cells(ZeilenCounter, 1).Value
    Sheets("Statistiken").Cells(ZeilenCounter, 1).Value = Daten(e)
    ZeilenCounter = ZeilenCounter + 1
    Next
   
    DatenEinlesenUndSchreiben

End Sub


Sub DatenEinlesenUndSchreiben()

    Dim Daten(13) As String
    Dim SpaltenCounter As Integer
    Dim ZeilenCounter As Integer

    ZeilenCounter = 1 'bis 19

    Do While ZeilenCounter <= 19
    SpaltenCounter = 2
    For e = 0 To 13
    Daten(e) = Sheets(DatenQuelle).Cells(ZeilenCounter, SpaltenCounter).Value
    Sheets("Statistiken").Cells(ZeilenCounter, SpaltenCounter).Value = Daten(e)
    SpaltenCounter = SpaltenCounter + 1
    Next
    ZeilenCounter = ZeilenCounter + 1
    Loop
   
    Sheets("Statistiken").Cells(1, 2).Value = "Jan"
    Sheets("Statistiken").Cells(1, 3).Value = "Feb"
    Sheets("Statistiken").Cells(1, 4).Value = "Mrz"
    Sheets("Statistiken").Cells(1, 5).Value = "Apr"
    Sheets("Statistiken").Cells(1, 6).Value = "Mai"
    Sheets("Statistiken").Cells(1, 7).Value = "Jun"
    Sheets("Statistiken").Cells(1, 8).Value = "Jul"
    Sheets("Statistiken").Cells(1, 9).Value = "Aug"
    Sheets("Statistiken").Cells(1, 10).Value = "Sep"
    Sheets("Statistiken").Cells(1, 11).Value = "Okt"
    Sheets("Statistiken").Cells(1, 12).Value = "Nov"
    Sheets("Statistiken").Cells(1, 13).Value = "Dez"
   
    'Neue Zeilen für die Abschnittrenner einfügen
    ActiveSheet.Cells(9, 9).EntireRow.Insert
    ActiveSheet.Cells(12, 12).EntireRow.Insert
    ActiveSheet.Cells(17, 17).EntireRow.Insert
    ActiveSheet.Cells(23, 23).EntireRow.Insert

    FormatierungenAnpassen
   
End Sub

Sub Layout()

    'Festlegung der Ranges in Variabeln für die Spalten bzw. Zeilen grössen
    Dim SpaltenMonat As Range
    Set SpaltenMonat = ActiveSheet.Range("B1:P1")
   
    Dim StatistikZeilen As Range
    Set StatistikZeilen = ActiveSheet.Range("A1:A23")
   
    Dim StandortBezeichnungsZelle As Range
    Set StandortBezeichnungsZelle = ActiveSheet.Range("A1")
       
   
    'Festlegung der Ranges in Variabeln für die Umrandung diverser Zellenbereiche
    Dim ZellenUmrandung(4) As Range
    Set ZellenUmrandung(0) = ActiveSheet.Range("A1:P1")
    Set ZellenUmrandung(1) = ActiveSheet.Range("A2:A8")
    Set ZellenUmrandung(2) = ActiveSheet.Range("A10:A11")
    Set ZellenUmrandung(3) = ActiveSheet.Range("A13:A16")
    Set ZellenUmrandung(4) = ActiveSheet.Range("A18:A22")
       
    Application.ScreenUpdating = False

    'Druck-Einstellungen
    With Sheets("Statistiken").PageSetup
        .LeftFooter = "" & DatenQuelle
        .LeftMargin = Application.InchesToPoints(0.32)
        .RightMargin = Application.InchesToPoints(0.28)
        .TopMargin = Application.InchesToPoints(0.28)
        .Orientation = xlLandscape
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
   
    'Alle Zellen betreffende Eigenschaften
    With Cells.Font
        .Size = 12
    End With

    'Festlegung der Spaltenbreiten
    Columns("A").ColumnWidth = 37.5
    SpaltenMonat.ColumnWidth = 12
   
    'Festlegung der Zeilenhöhen
    StatistikZeilen.RowHeight = 28.5
   
    'Zeilenhöhen für die Abschnittrenner
    Dim AbschnittTrenner(3) As Range
    Set AbschnittTrenner(0) = ActiveSheet.Range("A9")
    Set AbschnittTrenner(1) = ActiveSheet.Range("A12")
    Set AbschnittTrenner(2) = ActiveSheet.Range("A17")
    Set AbschnittTrenner(3) = ActiveSheet.Range("A23")
       
    For a = 0 To 3
    With AbschnittTrenner(a)
        .RowHeight = 12
    End With
    Next
   
    'Zellen/Spalten Umrandung
    With ZellenUmrandung(0)
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
    End With
   
    For i = 1 To 4
    With ZellenUmrandung(i)
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
    End With
    Next
   
    'Spezielle Attribute für die diverse Spalten (Titelspalten etc.)
    With SpaltenMonat
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Font.Bold = True
    End With
   
    With StandortBezeichnungsZelle
        .VerticalAlignment = xlCenter
        .Font.Bold = True
        .Font.Size = 16
    End With
   
    With Cells.Range("A7:N7")
        .Font.Bold = True
    End With
   
    With Cells.Range("A14:N14")
        .Font.Bold = True
    End With
   
    With Cells.Range("P1:P3")
        .Interior.Color = RGB(230, 230, 230)
    End With
   
    With Cells.Range("O1:O3")
        .Interior.Color = RGB(210, 210, 210)
    End With


' Laufmeter-Umsatz aus Zelle 7/8 wird die allfällige Klammer ausgearbeitet, damit das 3. Diagramm korrekt Bezug nehmen kann
    With Sheets("Statistiken")
    Range("B57").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(R[-50]C="""","""",IF(""(""=TEXT(LEFT(R[-50]C,1),""#""),IF("")""=TEXT(MID(R[-50]C,3,1),""#""),VALUE(MID(R[-50]C,5,99)),VALUE(MID(R[-50]C,6,99))),R[-50]C))"
    Range("B57").Select
    Selection.AutoFill Destination:=Range("B57:M57"), Type:=xlFillDefault
    Range("B57:M57").Select
    Range("A57").Value = "Laufmeter Umsatz"
    Rows("57:57").Select
    Selection.EntireRow.Hidden = True
    Range("A1").Select
    End With
 
    Rankings
       
End Sub

Sub Rankings()

    Dim Rankings(9) As String 'bis 10
    Dim ZeilenCounter_Quelle As Integer
    Dim ZeilenCounter_Ziel As Integer
    Dim TrennScan As Integer
    Dim TrennScanCounter As Integer
       
    With Sheets("Statistiken")
    .Range("A44").Value = "Ranking nach Umsatz"
    .Range("A44").Font.Bold = True
    .Range("D44").Value = "Umsatz netto"
    .Range("D44").HorizontalAlignment = xlRight
    .Range("E44").Value = "Absatzrang"
    .Range("E44").HorizontalAlignment = xlRight
    .Range("G44").Value = "Ranking nach Absatz"
    .Range("G44").Font.Bold = True
    .Range("L44").Value = "Absatz"
    .Range("L44").HorizontalAlignment = xlRight
    .Range("M44").Value = "Umsatzrang"
    .Range("M44").HorizontalAlignment = xlRight
    End With
   
    'Ermittlung der Trennung zwischen Rang Umsatz und Rang Menge
    TrennScan = 23
    Do While Sheets(DatenQuelle).Cells(TrennScan, 1).Value <> "Titel"
    TrennScan = TrennScan + 1
    Loop
   
    TrennScanReset = TrennScan
    TrennScanCounter = TrennScan - 23
   
    TrennScanCounter = TrennScanCounter - 1
   
    'Ranking nach Umsatz
    ZeilenCounter_Quelle = 23
    ZeilenCounter_Ziel = 45
    For e = 0 To TrennScanCounter
        Rankings(e) = Sheets(DatenQuelle).Cells(ZeilenCounter_Quelle, 1).Value
        Sheets("Statistiken").Cells(ZeilenCounter_Ziel, 1).Value = Rankings(e)
        ZeilenCounter_Quelle = ZeilenCounter_Quelle + 1
        ZeilenCounter_Ziel = ZeilenCounter_Ziel + 1
    Next
   
    'Umsatz netto
    ZeilenCounter_Quelle = 23
    ZeilenCounter_Ziel = 45
    For e = 0 To TrennScanCounter
      Rankings(e) = Sheets(DatenQuelle).Cells(ZeilenCounter_Quelle, 4).Value
      Sheets("Statistiken").Cells(ZeilenCounter_Ziel, 4).Value = Rankings(e)
      ZeilenCounter_Quelle = ZeilenCounter_Quelle + 1
      ZeilenCounter_Ziel = ZeilenCounter_Ziel + 1
    Next
   
    'Absatzrang
    ZeilenCounter_Quelle = 23
    ZeilenCounter_Ziel = 45
    For e = 0 To TrennScanCounter
      Rankings(e) = Sheets(DatenQuelle).Cells(ZeilenCounter_Quelle, 5).Value
      Sheets("Statistiken").Cells(ZeilenCounter_Ziel, 5).Value = Rankings(e)
      ZeilenCounter_Quelle = ZeilenCounter_Quelle + 1
      ZeilenCounter_Ziel = ZeilenCounter_Ziel + 1
    Next
   
    TrennScan = TrennScan + 1
   
    'Ranking nach Absatz
    ZeilenCounter_Quelle = TrennScan
    ZeilenCounter_Ziel = 45
    For e = 0 To 9
        Rankings(e) = Sheets(DatenQuelle).Cells(ZeilenCounter_Quelle, 1).Value
        Sheets("Statistiken").Cells(ZeilenCounter_Ziel, 7).Value = Rankings(e)
        ZeilenCounter_Quelle = ZeilenCounter_Quelle + 1
        ZeilenCounter_Ziel = ZeilenCounter_Ziel + 1
    Next
 
   
    'Menge
    ZeilenCounter_Quelle = TrennScan
    ZeilenCounter_Ziel = 45
    For e = 0 To 9
        Rankings(e) = Sheets(DatenQuelle).Cells(ZeilenCounter_Quelle, 4).Value
        Sheets("Statistiken").Cells(ZeilenCounter_Ziel, 12).Value = Rankings(e)
        ZeilenCounter_Quelle = ZeilenCounter_Quelle + 1
        ZeilenCounter_Ziel = ZeilenCounter_Ziel + 1
    Next
   
    'Umsatzrang
    ZeilenCounter_Quelle = TrennScan
    ZeilenCounter_Ziel = 45
    For e = 0 To 9
        Rankings(e) = Sheets(DatenQuelle).Cells(ZeilenCounter_Quelle, 5).Value
        Sheets("Statistiken").Cells(ZeilenCounter_Ziel, 13).Value = Rankings(e)
        ZeilenCounter_Quelle = ZeilenCounter_Quelle + 1
        ZeilenCounter_Ziel = ZeilenCounter_Ziel + 1
    Next
       
    DiagrammErstellenUmsatzentwicklung

End Sub

Sub DiagrammErstellenUmsatzentwicklung()

    Dim Dia1 As ChartObject
   
    If DatenKontrolle_Umsatzentwicklung = True Then

    Set Dia1 = ActiveSheet.ChartObjects.Add(Left:=0, Width:=470, Top:=585, Height:=300)
    Dia1.Name = "Umsatzentwicklung"
   
    ActiveSheet.ChartObjects("Umsatzentwicklung").Activate
   
    With ActiveChart
    .ChartType = xlColumnClustered
    .SetSourceData Source:=Sheets(DatenQuelle).Range("B2:M4"), PlotBy:=xlRows
    .SeriesCollection(1).XValues = ""
    .SeriesCollection(1).Name = Sheets(DatenQuelle).Range("A2")
    .SeriesCollection(2).XValues = ""
    .SeriesCollection(2).Name = Sheets(DatenQuelle).Range("A3")
    .SeriesCollection(3).XValues = ""
    .SeriesCollection(3).Name = Sheets(DatenQuelle).Range("A4")
    .SeriesCollection(1).XValues = Sheets(s).Range("B1:M1")
    .SeriesCollection(2).XValues = Sheets(s).Range("B1:M1")
    .SeriesCollection(3).XValues = Sheets(s).Range("B1:M1")
    End With
   
    Application.CutCopyMode = False
   
    With ActiveChart
        .HasLegend = True
        .Legend.Position = xlBottom
        .HasTitle = True
        .ChartTitle.Text = "Umsatzentwicklung"
        .ChartTitle.Font.Bold = True
        .ChartTitle.Font.Size = 12
    End With
   
    With ActiveChart.Axes(xlValue)
        .MinimumScale = 0
        .MaximumScaleIsAuto = True
        .MinorUnitIsAuto = True
        .MajorUnitIsAuto = True
        .Crosses = xlAutomatic
        .ReversePlotOrder = False
        .ScaleType = xlLinear
        .DisplayUnit = xlNone
    End With
   
    End If

    DiagrammErstellenLagerumschlagshaeufigkeit

End Sub

Sub DiagrammErstellenLagerumschlagshaeufigkeit()
   
    Dim Dia2 As ChartObject
   
    If DatenKontrolle_Lagerumschlagshaeufigkeit = True Then
   
    Set Dia2 = ActiveSheet.ChartObjects.Add(Left:=480, Width:=470, Top:=585, Height:=300)
    Dia2.Name = "Lagerumschlagshäufigkeit"
   
    ActiveSheet.ChartObjects("Lagerumschlagshäufigkeit").Activate
    With ActiveChart
    .ChartType = xlColumnClustered
    .SetSourceData Source:=Sheets(DatenQuelle).Range("A11:M12")
    .SeriesCollection(2).Select
    .SeriesCollection(2).ChartType = xlLineMarkers
    .SeriesCollection(2).Select
    .SeriesCollection(2).AxisGroup = 2
    End With
   
    With Selection.Format.Line
        .Visible = msoTrue
        .Weight = 1
    End With
    With Selection
        .MarkerStyle = 1
        .MarkerSize = 5
    End With
    Selection.MarkerStyle = 2
    Selection.MarkerSize = 4
    Selection.MarkerSize = 3
    Selection.MarkerSize = 4
    With Selection.Format.Line
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorAccent6
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0
    End With
    With Selection.Format.Line
        .Visible = msoTrue
        .Weight = 1.5
    End With
    ActiveChart.ChartArea.Select
    ActiveChart.Legend.Select
    ActiveChart.Legend.Select
    Selection.Position = xlBottom
    Selection.Format.Fill.Visible = msoFalse
    Selection.Format.Line.Visible = msoFalse
    Range("L25").Select
    ActiveSheet.ChartObjects("Lagerumschlagshäufigkeit").Activate
    ActiveSheet.ChartObjects("Lagerumschlagshäufigkeit").Activate
    ActiveSheet.ChartObjects("Lagerumschlagshäufigkeit").Activate
    ActiveChart.SetElement (msoElementChartTitleCenteredOverlay)
    ActiveChart.SetElement (msoElementChartTitleAboveChart)
    ActiveChart.ChartTitle.Text = "Lagerumschlagshäufigkeit"
    Selection.Format.TextFrame2.TextRange.Characters.Text = _
        "Lagerumschlagshäufigkeit"
    With Selection.Format.TextFrame2.TextRange.Characters(1, 24).ParagraphFormat
        .TextDirection = msoTextDirectionLeftToRight
        .Alignment = msoAlignCenter
    End With
    With Selection.Format.TextFrame2.TextRange.Characters(1, 24).Font
        .BaselineOffset = 0
        .Bold = msoTrue
        .NameComplexScript = "+mn-cs"
        .NameFarEast = "+mn-ea"
        .Fill.Visible = msoTrue
        .Fill.ForeColor.RGB = RGB(0, 0, 0)
        .Fill.Transparency = 0
        .Fill.Solid
        .Size = 18
        .Italic = msoFalse
        .Kerning = 12
        .Name = "+mn-lt"
        .UnderlineStyle = msoNoUnderline
        .Strike = msoNoStrike
    End With
    Selection.Format.Fill.Visible = msoFalse
    Selection.Format.Line.Visible = msoFalse
    With Selection.Format.TextFrame2.TextRange.Font
        .BaselineOffset = 0
        .Size = 12
    End With
    End If
   
    DiagrammErstellenLaufmeterUmsatz
   
End Sub

Sub DiagrammErstellenLaufmeterUmsatz()

    Dim ZellenZaehlen As Integer
    Dim Kontrollbereich As Range
    Dim DatenKontrolleVergleichsStandort As Boolean
   
    Dim Dia3 As ChartObject
   
    If Sheets(DatenQuelle).Cells(7, 2).Value = "" Then
        Sheets(DatenQuelle).Cells(7, 2).Value = 0
    End If
   
   
    Set Kontrollbereich = Sheets(DatenQuelle).Range("B8:M8")
 
    ZellenZaehlen = Application.WorksheetFunction.CountA(Kontrollbereich)
 
    If ZellenZaehlen >= 1 Then
        DatenKontrolleVergleichsStandort = True
    Else
        DatenKontrolleVergleichsStandort = False
    End If

    If DatenKontrolleVergleichsStandort = False Then
   
    Set Dia3 = ActiveSheet.ChartObjects.Add(Left:=960, Width:=470, Top:=585, Height:=300)
    Dia3.Name = "LaufmeterUmsatz"
   
    ActiveSheet.ChartObjects("LaufmeterUmsatz").Activate
    ActiveChart.ChartType = xlLineMarkers
    ActiveChart.SetSourceData Source:=Sheets(DatenQuelle).Range("A7:M7, A8:M8"), PlotBy:=xlRows
    ActiveChart.SeriesCollection(1).XValues = Sheets(s).Range("B1:M1")
    ActiveChart.SeriesCollection(1).Name = Sheets(DatenQuelle).Range("A7")
    ActiveChart.SeriesCollection(2).Name = Sheets(DatenQuelle).Range("A8")
    ActiveChart.SeriesCollection(1).Values = "=Statistiken!$B$57:$M$57"
       
    With ActiveChart
        .HasTitle = True
        .HasLegend = True
        .Legend.Position = xlBottom
        .ChartTitle.Characters.Text = "Laufmeter Umsatz"
        .ChartTitle.Font.Bold = True
        .ChartTitle.Font.Size = 12
        .Axes(xlCategory, xlPrimary).HasTitle = False
        .Axes(xlValue, xlPrimary).HasTitle = False
    End With
             
    With ActiveChart
        .PlotVisibleOnly = False
    End With
   
    End If
   
    Sheets("Statistiken").Cells(1, 1).Activate
   
    If Drucken = True Then
    Sheets("Statistiken").PrintOut
    End If
   
    Drucken = False
   
    'Seitendarstellung bzw. Zoom-Einstellung
    With ActiveWindow
    .Zoom = 65
    .DisplayGridlines = False
    End With
   
    Delta_Umsatz
   
End Sub

Sub Delta_Umsatz()
'
' Hier wird das Delta zum Vorjahr ausgewiesen
'
   
    Sheets("Statistiken").Cells(1, 15).Value = "D YTD"
   
    With Sheets("Statistiken").Cells(1, 15).Characters(Start:=1, Length:=2).Font
        .Name = "Symbol"
    End With
    With Sheets("Statistiken").Cells(1, 15).Characters(Start:=3, Length:=6).Font
        .Name = "Arial"
    End With
   
    Sheets("Statistiken").Cells(2, 15).FormulaR1C1 = "=RC[-1]/R[1]C[-1]-1"
    Sheets("Statistiken").Cells(3, 15).FormulaR1C1 = "=RC[-1]/R[1]C[-1]-1"
   
    Mt_VJ
   
End Sub

Sub Mt_VJ()
'
' Hier wird das Delta zum Vorjahr ausgewiesen
'
   
    Sheets("Statistiken").Cells(1, 16).Value = "D Mt. VJ"
   
    With Sheets("Statistiken").Cells(1, 16).Characters(Start:=1, Length:=2).Font
        .Name = "Symbol"
    End With
    With Sheets("Statistiken").Cells(1, 16).Characters(Start:=3, Length:=6).Font
        .Name = "Arial"
    End With
   
    Sheets("Statistiken").Cells(2, 16).FormulaR1C1 = "=VLOOKUP(RC[-14],RC[-14]:RC[-3],COUNT(RC[-14]:RC[-3]),FALSE)/VLOOKUP(R[1]C[-14],R[1]C[-14]:R[1]C[-3],COUNT(R[1]C[-14]:R[1]C[-3]),FALSE)-1"
    Sheets("Statistiken").Cells(3, 16).FormulaR1C1 = "=VLOOKUP(RC[-14],RC[-14]:RC[-3],COUNT(RC[-14]:RC[-3]),FALSE)/VLOOKUP(R[1]C[-14],R[1]C[-14]:R[1]C[-3],COUNT(R[1]C[-14]:R[1]C[-3]),FALSE)-1"
   
    Bruttogewinn_absolut
   
    'Application.ErrorCheckingOptions.BackgroundChecking = False
End Sub

Sub Bruttogewinn_absolut()
    Dim ZeilenCounter As Integer
    Dim SpaltenCounter As Integer
   
    Rows(7).Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
   
    Sheets("Statistiken").Cells(7, 1).Value = "Bruttogewinn absolut"
    Sheets(s).Range("B7:N7").NumberFormat = "#,##0" 'Bruttogewinn_absolut
   
    ZeilenCounter = 7
    SpaltenCounter = 2

    Do While SpaltenCounter <= 13
   
    Sheets("Statistiken").Cells(ZeilenCounter, SpaltenCounter).FormulaR1C1 = "=IF(R[-5]C-R[-2]C<>0,R[-5]C-R[-2]C,"""")"
   
    SpaltenCounter = SpaltenCounter + 1
    Loop
   
    Range("A1").Select
   
End Sub


Function DatenKontrolle_Lagerumschlagshaeufigkeit() As Boolean

    Dim KontrollFeld As Range
   
    Set KontrollFeld = Sheets(DatenQuelle).Range("B11")
   
    If KontrollFeld = "" Then
        KontrollFeld = 0
        DatenKontrolle_Lagerumschlagshaeufigkeit = True
        Else
        DatenKontrolle_Lagerumschlagshaeufigkeit = True
    End If
   
End Function

Function DatenKontrolle_Umsatzentwicklung() As Boolean

    Dim KontrollFeld As Range
   
    Set KontrollFeld = Sheets(DatenQuelle).Range("B2")
   
    If KontrollFeld = "" Then
        KontrollFeld = 0
        DatenKontrolle_Umsatzentwicklung = True
        Else
        DatenKontrolle_Umsatzentwicklung = True
    End If

End Function

Function StatistikKontrolle() As Boolean
     
    Dim Kontrolle_A2 As String
    Dim Kontrolle_A3 As String
   
    Kontrolle_A2 = Range("A2").Value
    Kontrolle_A3 = Range("A3").Value
   
    If Kontrolle_A2 = "Umsatz" And Kontrolle_A3 Like "Umsatz 20##" Then
    StatistikKontrolle = True
    Else
    StatistikKontrolle = False
    End If
       
End Function

Function StatistikOffenKontrolle(BlattName As String) As Boolean
    Dim Counter As Integer

    For i = 1 To Sheets.Count
        If BlattName = Sheets(i).Name Then
            Counter = Counter + 1
            Exit For
        End If
    Next i

    If Counter = 1 Then
    StatistikOffenKontrolle = True
        Else
    StatistikOffenKontrolle = False
    End If
   
End Function


Herzlichen Dank für Eure Unterstützung!

Liebe Grüsse
Darksidy

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

RSchulz
Ehrenmitglied V.I.P. h.c.
Head of CAD, Content & Collaboration / IT-Manager



Sehen Sie sich das Profil von RSchulz an!   Senden Sie eine Private Message an RSchulz  Schreiben Sie einen Gästebucheintrag für RSchulz

Beiträge: 5541
Registriert: 12.04.2007

@Work
Lenovo P510
Xeon E5-1630v4
64GB DDR4
Quadro P2000
256GB PCIe SSD
512GB SSD
SmarTeam V5-6 R2016 Sp04
CATIA V5-6 R2016 Sp05
E3.Series V2019
Altium Designer/Concord 19
Win 10 Pro x64

erstellt am: 26. Sep. 2013 11:41    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Darksidy 10 Unities + Antwort hilfreich

Code:

Sub ALausführen()
  Dim strVerzeichnis As String
  Dim strDatei As String
  Dim strTyp As String
  Dim strDateiname As String
  strTyp = "*.csv"
  Application.ScreenUpdating = False
  strVerzeichnis = "\\MEIN-VERZEICHNIS\"
  strDateiname = Dir(strVerzeichnis & strTyp)
  Do While strDateiname <> ""
      Workbooks.Open Filename:=strVerzeichnis & strDateiname
      call Start()
      ActiveWorkbook.SaveCopyAs Application.Substitute(strDateiname, ".csv", "") & ".xls"
      ActiveWorkbook.Close
     strDateiname = Dir
  Loop
  Application.ScreenUpdating = True
end sub
...
...

Public Sub Start()
   
    DatenQuelle = ActiveWorkbook.ActiveSheet.Name
    s = "Statistiken"

... ' hier gehts normal weiter


Hier hab mir jetzt nicht den gesamten Code durchgelesen, aber ich denke, dass du verstehst, wie ich das meine.

BTW Nimm immer eindeutige Namen. Ein Name "Start" ist absolut kritisch! Wenn, dann wenigstens "FormatCSV_start" oder so...

------------------
MFG
Rick Schulz

Nettiquette (CAD.de)  -  Was ist die Systeminfo?  -  Wie man Fragen richtig stellt.  -  Unities

[Diese Nachricht wurde von RSchulz am 26. Sep. 2013 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Darksidy
Mitglied
Controller


Sehen Sie sich das Profil von Darksidy an!   Senden Sie eine Private Message an Darksidy  Schreiben Sie einen Gästebucheintrag für Darksidy

Beiträge: 16
Registriert: 29.05.2013

erstellt am: 26. Sep. 2013 14:22    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Danke für die rasche Antwort.

Hab's nun so versucht, funktioniert aber noch nicht. Wo und wie habe ich "Public DatenQuelle As String", "Public s As String" und "Public Drucken As Boolean" zu definieren? Denn es erscheint nun die Fehlermeldung "Fehler Beim Kompilieren: Nach End Sub, End Function oder End Property können nur Kommentare stehen".

Wenn ich direkt mit "Call NeueArbeitsmappe()" (anstatt "Call Start()") arbeite (und "Public ..." von oben nicht im Code aufführe), entsteht weiter unten im Code bei "Sub TitelUndTexteEinlesenUndSchreiben ()" bei "Daten(e) = Sheets(DatenQuelle).Cells(ZeilenCounter, 1).Value" die Fehlermeldung: "Laufzeitfehler '9': Index ausserhalb des gültigen Bereichs".

Grüsse
Darksidy

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

HenryV
Mitglied
Konstrukteur, Engineering


Sehen Sie sich das Profil von HenryV an!   Senden Sie eine Private Message an HenryV  Schreiben Sie einen Gästebucheintrag für HenryV

Beiträge: 778
Registriert: 18.05.2005

SolidWorks 2020 x64 SP3.0
Dell Precision 5820
Intel Xeon W-2125 4x4GHz
NVIDIA Quadro P2000 5GB
32GB RAM
2x Dell U2412M, 24" TFT
Windows 10 Enterprise x64 21H1
Microsoft Office 365 ProPlus
Microsoft Visual Studio Enterprise 2022

erstellt am: 26. Sep. 2013 16:36    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities Nur für Darksidy 10 Unities + Antwort hilfreich


CSV-Import.zip

 
Hallo Darksidy

Ich habe ein bisschen an dem Code gefeilt und die zwei Makros kombiniert.
(z.B das Laden und Speichern der CSV-Dateien)

Das Resultat siehst du im Anhang.

Gruss Andreas

------------------
21 ist nur die halbe Antwort.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Darksidy
Mitglied
Controller


Sehen Sie sich das Profil von Darksidy an!   Senden Sie eine Private Message an Darksidy  Schreiben Sie einen Gästebucheintrag für Darksidy

Beiträge: 16
Registriert: 29.05.2013

erstellt am: 01. Okt. 2013 09:08    Editieren oder löschen Sie diesen Beitrag!  <-- editieren / zitieren -->   Antwort mit Zitat in Fett Antwort mit kursivem Zitat    Unities abgeben: 1 Unity (wenig hilfreich, aber dennoch)2 Unities3 Unities4 Unities5 Unities6 Unities7 Unities8 Unities9 Unities10 Unities

Hallo Andreas

Tausend Dank - perfekt!

Herzliche Grüsse und weiterhin einen guten Start in die neue Woche
Darksidy

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

Anzeige.:

Anzeige: (Infos zum Werbeplatz >>)

Darstellung des Themas zum Ausdrucken. Bitte dann die Druckfunktion des Browsers verwenden. | Suche nach Beiträgen

nächster neuerer Beitrag | nächster älterer Beitrag
Antwort erstellen


Diesen Beitrag mit Lesezeichen versehen ... | Nach anderen Beiträgen suchen | CAD.de-Newsletter

Administrative Optionen: Beitrag schliessen | Archivieren/Bewegen | Beitrag melden!

Fragen und Anregungen: Kritik-Forum | Neues aus der Community: Community-Forum

(c)2023 CAD.de | Impressum | Datenschutz