Thema Datum  Von Nutzer Rating
Antwort
30.06.2014 01:21:50 Tribal
NotSolved
30.06.2014 03:43:40 Gast70385
NotSolved
Rot Excel VBA - Leerzeichen und Eurozeichen aus Zellen entfernen
30.06.2014 04:20:25 Tribal
NotSolved
30.06.2014 07:26:07 Gast28505
NotSolved
30.06.2014 04:23:49 Tribal
NotSolved

Ansicht des Beitrags:
Von:
Tribal
Datum:
30.06.2014 04:20:25
Views:
1010
Rating: Antwort:
  Ja
Thema:
Excel VBA - Leerzeichen und Eurozeichen aus Zellen entfernen

Hallo,

es funzt leider nicht. Ich zeig einfach mal den ganzen Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
Option Explicit
 
Sub ImportCSV()
     
    Dim shtImport   As Worksheet
    Dim strFileName As String
    Const Num1     As Long = 1
    Dim RowsMax1    As Long
    Dim RowsMax2   As Long
    Dim Row         As Long
 
    ' Delete Clear Rows
With Import
    RowsMax2 = .UsedRange.Rows.Count
     
    For Row = RowsMax2 To 4 Step -1
     
    If Application.WorksheetFunction.CountA(.Rows(Row)) = 0 Then
     .Rows(Row).Delete
    End If
    Next Row
End With
 
    ' Detect RowMax for Import
RowsMax1 = Import.UsedRange.Rows.Count
RowsMax1 = CDbl(Num1) + CDbl(RowsMax1)
          
    ' Change the name "Import" according to your sheet name.
Set shtImport = Sheets("Import")
       
    ' Show the file dialog and select a CSV file.
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = False
    .Title = "Select a CSV file!"
    .Filters.Clear
    .Filters.Add "Semicolon Separated Values", "*.csv"
    .Show
         
    If .SelectedItems.Count = 0 Then
        MsgBox "You did't select a CSV file!", vbExclamation, "Canceled"
        Exit Sub
    Else
        strFileName = .SelectedItems(1)
    End If
End With
     
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & strFileName, Destination:=Range("$A" & RowsMax1))
    .Name = "strFileName"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = False '''
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = 65001
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = False
    .TextFileSemicolonDelimiter = True
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(4, 2, 2, 2, 1)
    .TextFileTrailingMinusNumbers = True
    .Refresh BackgroundQuery:=False
End With
     
    ' Turn OFF the Screenupdating
Application.ScreenUpdating = False
     
    ' Check if the selected file is CSV file.
If UCase(Right(strFileName, 3)) <> "CSV" Then
    MsgBox "The file you select is not a CSV file!", vbCritical, "Error!"
    Exit Sub
End If
     
    ' Remove duplicated Rows
Range("A3:E320000").Select
ActiveSheet.Range("$A$3:$E$320000").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), _
Header:=xlYes
     
    ' Leere Zelen loeschen
With Import
    RowsMax2 = .UsedRange.Rows.Count
    For Row = RowsMax2 To 4 Step -1
    If Application.WorksheetFunction.CountA(.Rows(Row)) = 0 Then
        .Rows(Row).Delete
    End If
Next Row
End With
     
    ' Replace Euro Sighn
'ActiveSheet.UsedRange.Replace " €", "", LookAt:=xlPart
 
    ' Turn ON the Screenupdating
Application.ScreenUpdating = True
 
    ' Inform the user about the process.
MsgBox "The file " & strFileName & " was successfully imported on sheet " & _
shtImport.Name & "!", vbInformation, "Done"
      
End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
30.06.2014 01:21:50 Tribal
NotSolved
30.06.2014 03:43:40 Gast70385
NotSolved
Rot Excel VBA - Leerzeichen und Eurozeichen aus Zellen entfernen
30.06.2014 04:20:25 Tribal
NotSolved
30.06.2014 07:26:07 Gast28505
NotSolved
30.06.2014 04:23:49 Tribal
NotSolved