Dezimaltrennzeichen auswählen und Daten richtig anzeigen

Hallo zusammen,

ich habe ein Makro wo von Mitarbeiter ausgewählt werden kann ob er als Dezimaltrennzeichen Punkt oder Komma haben möchte.

Hat da jemand eine Idee dazu? Die Daten sollen mit diesen Trennzeichen aus den CSV Files in meine Mappe importiert werden sowie auch mit diesem Trennzeichen dargestellt werden

BeispielDatei
https://www.herber.de/bbs/user/164857.xlsm
'deklarieren und initialisieren von öffentlichen variablen

Option Explicit

Dim wsOutput As Worksheet

Dim sql_cmd As String

Dim decimaltrenner As Variant

Dim sql_result As Variant

Dim metis As Object

Sub Messung()



'Deaktivieren von Bildschirm Updates während Lauf des Makros

Application.ScreenUpdating = False

'Deaktivieren von Bildschirm Alarmen während Lauf des Makros

Application.DisplayAlerts = False



'Einblenden des Worksheets für die SAP Stückzahl

Sheets("Output_SAP").Visible = True

Sheets("Dezimaltrennzeichen").Visible = True

Sheets("Daten_BufferFile").Visible = True

decimaltrenner = Application.International(xlDecimalSeparator)





'deklarieren von Variablen

Dim a As Integer

Dim wsh As Worksheet

Dim ws As Worksheet

Dim DateiPfad As String

Dim LosnummerFuerDateien As String

Dim Lrow1 As Integer

Dim Current As Worksheet

Dim shtCount As Integer

Dim UpperControlLimitDicke As Double

Dim LowerControlLimitDicke As Double

Dim UpperControlLimitAuslenkung As Double

Dim LowerControlLimitAuslenkung As Double

Dim UpperControlLimitRIS As Double

Dim LowerControlLimitRIS As Double

Dim UpperControlLimitFrequenz As Double

Dim LowerControlLimitFrequenz As Double

Dim AnzahlVonMessungen As Integer

Dim StueckzahlSAP As Integer

Dim Lrow2 As Integer

Dim strSkip As String



Anfang:

'aufbau der Verbindung mit Datenbank für SAP

Set metis = Ora_connect("METIS", "auskunft", "auskunft")



'gewünschten Losnummer übergabe

LosnummerFuerDateien = Sheets("Start").Range("A4").Value



'Festlegen des Speicherortes

DateiPfad = Sheets("Start").Range("C7").Value

DateiPfad = DateiPfad & "\" & LosnummerFuerDateien & "*.*"



'set to current worksheet name

Set ws = ActiveWorkbook.Sheets("Rohdaten_gesamt")



'nicht benötigte tabellen löschen

    strSkip = "Start, Rohdaten_gesamt, Auswertung, Output_SAP, Daten_BufferFile, Dezimaltrennzeichen"

    For Each wsh In Worksheets

        If InStr(strSkip, wsh.Name) = 0 Then

            wsh.Delete

        End If

    Next

    

    'Daten von vorherigen Durchlauf löschen

    Worksheets("Rohdaten_gesamt").Rows(2 & ":" & Worksheets("Rohdaten_gesamt").Rows.Count).Delete



    Sheets("Start").Activate

    If Range("C4").Value = "," Then

        'Datei auswählen und importieren

        Dim fd As FileDialog, Lrow As Long, vSelectedItem As Variant, srcWB As Workbook, desWB As Workbook

        Set desWB = ThisWorkbook

        Set fd = Application.FileDialog(msoFileDialogFilePicker)

        With fd

            .AllowMultiSelect = True

            .InitialFileName = DateiPfad

            .Filters.Clear

            If .Show = -1 Then

                For Each vSelectedItem In .SelectedItems

                    Application.DecimalSeparator = ","

                    Application.ThousandsSeparator = "."

                    'csv files nach semikolon trennen

                    Workbooks.OpenText fileName:=vSelectedItem _

                    , Origin:=65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _

                    xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=True, _

                    Comma:=False, Space:=False, Other:=False, FieldInfo:= _

                    Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7 _

                    , 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array _

                    (14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), _

                    Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array( _

                     27, 1), Array(28, 1)), DecimalSeparator:=",", ThousandsSeparator:="."

                     'Prüfen ob ersten 9 stellen von links der Datei mit gewünschter Losnummer übereinstimmen

                    If Left(ActiveWorkbook.Name, 9) = LosnummerFuerDateien Then

                        Set srcWB = ActiveWorkbook

                        ActiveSheet.Name = ActiveWorkbook.Name

                        Sheets(1).Copy After:=desWB.Sheets(desWB.Sheets.Count)

                        srcWB.Close

                    Else

                        ActiveWorkbook.Close

                        GoTo Iteration

                    End If

Iteration:

                Next

            Else

                MsgBox ("Es wurde keine Datei ausgewählt, bitte erneut versuchen")

                Exit Sub

            End If

        End With

    ElseIf Range("C4").Value = "." Then

        'Datei auswählen und importieren

        Dim fd1 As FileDialog, Lrow5 As Long, vSelectedItem1 As Variant, srcWB1 As Workbook, desWB1 As Workbook

        Set desWB1 = ThisWorkbook

        Set fd1 = Application.FileDialog(msoFileDialogFilePicker)

        With fd1

            .AllowMultiSelect = True

            .InitialFileName = DateiPfad

            .Filters.Clear

            If .Show = -1 Then

                For Each vSelectedItem1 In .SelectedItems

                    Application.DecimalSeparator = "."

                    Application.ThousandsSeparator = ","

                    'csv files nach semikolon trennen

                    Workbooks.OpenText fileName:=vSelectedItem1 _

                    , Origin:=65001, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _

                    xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, Semicolon:=True, _

                    Comma:=False, Space:=False, Other:=False, FieldInfo:= _

                    Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7 _

                    , 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array _

                    (14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), _

                    Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array( _

                     27, 1), Array(28, 1)), DecimalSeparator:=".", ThousandsSeparator:=","

                     'Prüfen ob ersten 9 stellen von links der Datei mit gewünschter Losnummer übereinstimmen

                    If Left(ActiveWorkbook.Name, 9) = LosnummerFuerDateien Then

                        Set srcWB1 = ActiveWorkbook

                        ActiveSheet.Name = ActiveWorkbook.Name

                        Sheets(1).Copy After:=desWB1.Sheets(desWB1.Sheets.Count)

                        srcWB1.Close

                    Else

                        ActiveWorkbook.Close

                        GoTo Iteration20

                    End If

Iteration20:

                Next

            Else

                MsgBox ("Es wurde keine Datei ausgewählt, bitte erneut versuchen")

                GoTo Anfang

            End If

        End With

    End If

    

    Sheets("Auswertung").Activate

    'Diagramme löschen

    'Diagramm Dicke löschen

    ActiveSheet.ChartObjects("Dicke").Activate

    Selection.Delete

    'Diagramm Auslenkung löschen

    ActiveSheet.ChartObjects("Auslenkung").Activate

    Selection.Delete

    'Diagramm RIS löschen

    ActiveSheet.ChartObjects("RIS").Activate

    Selection.Delete

    'Diagramm C - Klein löschen

    ActiveSheet.ChartObjects("C - Klein").Activate

    Selection.Delete

    'Diagramm Frequenz löschen

    ActiveSheet.ChartObjects("Frequenz").Activate

    Selection.Delete

    

    'Anzahl der Sheets zählen

    'shtCount = Sheets.Count

    'If shtCount = 6 Then

     '   GoTo Iteration1

    'Else

        'werte für berechnung der statistik aus header von den einzelnen rohdaten files holen

        For Each Current In ThisWorkbook.Worksheets

            If Current.Name = "Start" Or Current.Name = "Rohdaten_gesamt" Or Current.Name = "Auswertung" Or Current.Name = "Output_SAP" Or Current.Name = "Daten_BufferFile" Or Current.Name = "Dezimaltrennzeichen" Then

                GoTo Iteration2

            Else

                Current.Activate

                Range("A15").Select

                LowerControlLimitDicke = Right(ActiveCell.Value, 3)

                ActiveCell.Offset(1, 0).Select

                UpperControlLimitDicke = Right(ActiveCell.Value, 3)

                Range("A52").Select

                LowerControlLimitAuslenkung = Right(ActiveCell.Value, 3)

                ActiveCell.Offset(1, 0).Select

                UpperControlLimitAuslenkung = Right(ActiveCell.Value, 3)

                Range("A82").Select

                UpperControlLimitFrequenz = Right(ActiveCell.Value, 5) / 1000

                ActiveCell.Offset(1, 0).Select

                LowerControlLimitFrequenz = Right(ActiveCell.Value, 5) / 1000

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

                Range("A92:AB" & Lrow2).Select

                Selection.Copy

                Sheets("Rohdaten_gesamt").Activate

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

                Cells(Lrow1 + 1, 1).Select

                ActiveSheet.Paste

            End If

Iteration2:

        Next Current

    'End If



    'aufrufen der externen funktionen für erstellung der histogramme

    Call Create_HistogramDicke

    Call Create_HistogramAuslenkung

    Call Create_HistogramRIS

    Call Create_HistogramCKlein

    Call Create_HistogramFrequenz



    'sql abfrage an datenbank für SAP Stückzahl

    sql_cmd = "SELECT a.RMENGE, a.TEXT FROM vs.KOPFLL k INNER JOIN vs.APOSLL a ON (k.LOSNR = a.LOSNR) WHERE a.TEXT = 'POLEN / MESSEN AUSLENKUNG' And k.LOSNR = '" & LosnummerFuerDateien & "'"

    sql_result = sql_request(metis, sql_cmd)

    Set wsOutput = ThisWorkbook.Sheets("Output_SAP")

    wsOutput.UsedRange.ClearContents

    Call sql2table(sql_result, ThisWorkbook.Name, wsOutput.Name, 1, 2, 1, False, True)

    

    'einfügen aller Formeln für statistischen werte

    Sheets("Auswertung").Activate

    Range("B3").Select

    ActiveCell.FormulaR1C1 = "=SUBTOTAL(1,Rohdaten_gesamt!C[1])"

    ActiveCell.Offset(1, 0).Select

    ActiveCell.FormulaR1C1 = "=SUBTOTAL(1,Rohdaten_gesamt!C[2])"

    ActiveCell.Offset(1, 0).Select

    ActiveCell.FormulaR1C1 = "=SUBTOTAL(1,Rohdaten_gesamt!C[7])"

    ActiveCell.Offset(1, 0).Select

    ActiveCell.FormulaR1C1 = "=SUBTOTAL(1,Rohdaten_gesamt!C[8])"

    ActiveCell.Offset(1, 0).Select

    ActiveCell.FormulaR1C1 = "=SUBTOTAL(1,Rohdaten_gesamt!C[10]) / 1000"

    ActiveCell.Offset(-4, 1).Select

    ActiveCell.FormulaR1C1 = "=SUBTOTAL(8,Rohdaten_gesamt!C)"

    ActiveCell.Offset(1, 0).Select

    ActiveCell.FormulaR1C1 = "=SUBTOTAL(8,Rohdaten_gesamt!C[1])"

    ActiveCell.Offset(1, 0).Select

    ActiveCell.FormulaR1C1 = "=SUBTOTAL(8,Rohdaten_gesamt!C[6])"

    ActiveCell.Offset(1, 0).Select

    ActiveCell.FormulaR1C1 = "=SUBTOTAL(8,Rohdaten_gesamt!C[7])"

    ActiveCell.Offset(1, 0).Select

    ActiveCell.FormulaR1C1 = "=SUBTOTAL(8,Rohdaten_gesamt!C[9]) / 1000"

    ActiveCell.Offset(-4, 2).Select

    ActiveCell.Value = UpperControlLimitDicke

    ActiveCell.Offset(0, 1).Select

    ActiveCell.Value = LowerControlLimitDicke

    ActiveCell.Offset(1, -1).Select

    ActiveCell.Value = UpperControlLimitAuslenkung

    ActiveCell.Offset(0, 1).Select

    ActiveCell.Value = LowerControlLimitAuslenkung

    ActiveCell.Offset(1, 0).Select

    ActiveCell.Value = "75"

    ActiveCell.Offset(0, -1).Select

    ActiveCell.Value = "139"

    ActiveCell.Offset(1, 0).Select

    ActiveCell.Value = "3"

    ActiveCell.Offset(0, 1).Select

    ActiveCell.Value = "2"

    ActiveCell.Offset(1, 0).Select

    ActiveCell.Value = LowerControlLimitFrequenz

    ActiveCell.Offset(0, -1).Select

    ActiveCell.Value = UpperControlLimitFrequenz

    

    'filter setzen für nur gute messungen

    Worksheets("Rohdaten_gesamt").Range("A1:AB1").AutoFilter Field:=28, Criteria1:="Good"

    

    

    'anzahl von durchgeführten messungen zählen

    Sheets("Rohdaten_gesamt").Activate

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

    AnzahlVonMessungen = WorksheetFunction.Subtotal(3, Range("A2:A" & Lrow2))

    Columns("A:AB").EntireColumn.AutoFit

    Columns("A:AB").Select

    With Selection

        .HorizontalAlignment = xlLeft

        .VerticalAlignment = xlBottom

    End With

    Sheets("Output_SAP").Activate

    StueckzahlSAP = Range("A2").Value

    Sheets("Auswertung").Activate

    Range("K3").Select

    ActiveCell.Value = AnzahlVonMessungen

    ActiveCell.Offset(0, -1).Select

    ActiveCell.Value = StueckzahlSAP

    'prüfen ob stückzahl aus SAP auch in messungen vorhanden ist

    If Range("J3").Value > Range("K3").Value Then

        Range("J3:K3").Select

        Selection.Interior.ColorIndex = 3

    Else

        Range("J3:K3").Select

        Selection.Interior.ColorIndex = 4

    End If

    

    Sheets("Output_SAP").Select

    'Output SAP ausblenden

    ActiveWindow.SelectedSheets.Visible = False

    Sheets("Auswertung").Activate

    Sheets("Dezimaltrennzeichen").Visible = False

    Sheets("Daten_BufferFile").Visible = False

    

    

    Sheets("Auswertung").Select

    Application.Wait (1000)

    Call refreshHistogram

 

    

'Iteration1:

End Sub
Beiträge zum Forumthread
Beiträge zu diesem Forumthread
Betreff
Datum
Anwender
Beliebteste Forumthreads (12 Monate)
Dezimaltrennzeichen auswählen und Daten richtig anzeigen

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Dezimaltrennzeichen auswählen und Daten richtig anzeigen

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread
