Thema Datum  Von Nutzer Rating
Antwort
26.06.2014 11:11:47 Tribal
NotSolved
26.06.2014 14:05:48 Gast8572
NotSolved
26.06.2014 21:27:27 Gast68490
NotSolved
26.06.2014 21:27:31 Gast61951
NotSolved
28.06.2014 07:14:06 Gast803
NotSolved
Blau Excel VBA - Daten aus CSV Dateien Importieren
29.06.2014 23:39:56 Tribal
Solved

Ansicht des Beitrags:
Von:
Tribal
Datum:
29.06.2014 23:39:56
Views:
890
Rating: Antwort:
 Nein
Thema:
Excel VBA - Daten aus CSV Dateien Importieren

Hallo,

Ich danke vielmals. Habe es jetzt nochmal getestet und den gesammten Code ein bissl schön gemacht und es Funzt alles so wie ich es gerne hätte.

Hier der Code:

 

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

    ' 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
26.06.2014 11:11:47 Tribal
NotSolved
26.06.2014 14:05:48 Gast8572
NotSolved
26.06.2014 21:27:27 Gast68490
NotSolved
26.06.2014 21:27:31 Gast61951
NotSolved
28.06.2014 07:14:06 Gast803
NotSolved
Blau Excel VBA - Daten aus CSV Dateien Importieren
29.06.2014 23:39:56 Tribal
Solved