Dezimaltrennzeichen auswählen und Daten richtig anzeigen

Hallo zusammen,

ich habe auf meinem Start Sheet in Zelle A20 eine Listbox wo man das Dezimaltrennzeichen auswählen kann (. oder ,) der Sinn dahinter ist folgender:
Jenachdem welche Einstellung die verschiedenen Mitarbeiter in Excel hinterlegt haben kann es zu Problemen mit der zusammenführung sowie aufteilung von den CSV Files kommen. Daher sollen die Mitarbeiter ihr Trennzeichen vor Makro start angeben.

Wie kann ich das am besten in meinen Code implementieren? Das Makro ist nämlich schon ganz fertig und das war jetzt noch ein Wunsch eines Arbeiters dem dieses Problem aufgefallen ist.

BeispielDatei:
https://www.herber.de/bbs/user/164375.xlsm

'deklarieren und initialisieren von öffentlichen variablen

Option Explicit

Dim wsOutput As Worksheet

Dim sql_cmd As String

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





'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("A13").Value



'Festlegen des Speicherortes

DateiPfad = Sheets("Start").Range("A11").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("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

    

'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

                '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, OtherChar:=";", 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)), TrailingMinusNumbers:=True

                 '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")

            GoTo Anfang

        End If

    End With



    '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 externe 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").Visible = False

    Sheets("Dezimaltrennzeichen").Visible = False

    Sheets("Daten_BufferFile").Visible = False

Iteration1:

End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi

das Trennzeichen musst du als Parameter im Workbook.OpenText (da wo die vielen anderen Parameter stehen) mit angeben.
Wie das genau aussieht (Parametername) kannst du am einfachsten selbst rausfinden, in dem du die Menüfunktion DATEN - DATENTOOLS - TEXT IN SPALTEN ausführst und aufzeichnest und dir dann den aufgezeichneten Code anschaust.

OpenText ist quasi ein Dateiöffnen mit angeschlossenem Text-in-Spalten, daher kannst du die Parameter vom Text-In-Spalten auch im OpenText anwenden.

damit das Festlegen des Dezimaltrenners auch aufgezeichnet wird, musst du diesen aktiv verändern. Ohne Änderung zeichnet der Recorder das nicht auf.
Den Dezimaltrenner kannst du ändern, wenn du im Schritt 3 des Assistenten auf WEITERE klickst.

Gruß Daniel

Beliebteste Forumthreads (12 Monate)

Dezimaltrennzeichen auswählen und Daten richtig anzeigen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread