Thema Datum  Von Nutzer Rating
Antwort
28.06.2014 21:36:43 Tribal
NotSolved
28.06.2014 22:52:38 Gast74988
NotSolved
29.06.2014 02:30:07 Gast89069
NotSolved
Blau Excel VBA - Zeichenkette suchen und ersetzten
29.06.2014 16:41:14 Tribal
NotSolved
29.06.2014 17:42:01 Gast19313
NotSolved
29.06.2014 20:48:26 Tribal
NotSolved
29.06.2014 21:43:54 Gast11929
NotSolved
29.06.2014 21:46:08 Gast96854
*****
Solved
29.06.2014 23:37:35 Tribal
Solved

Ansicht des Beitrags:
Von:
Tribal
Datum:
29.06.2014 16:41:14
Views:
875
Rating: Antwort:
  Ja
Thema:
Excel VBA - Zeichenkette suchen und ersetzten

Hallo,

der Code sieht so aus:

 

Option Explicit

Sub ImportCSV()
    
    Dim shtImport   As Worksheet
    Dim strDelChar  As String
    Dim strFileName As String
    Dim lRow        As Long
    Dim lCol        As Long
    Dim strText     As String
    Dim strChar     As String * 1
    Dim vntData     As Variant
    Dim lCharCount  As Long
    Const Zahl1     As Long = 1
    Dim ZeileMax    As Long
    Dim ZeileMax1   As Long
    Dim Row         As Long
    Dim rootDir     As String

    'Leere Zeilen entfernen
With Import
    ZeileMax1 = .UsedRange.Rows.Count
    
    For Row = ZeileMax1 To 4 Step -1
    
    If Application.WorksheetFunction.CountA(.Rows(Row)) = 0 Then
     .Rows(Row).Delete
    End If
    Next Row
End With

    'Zeile für Import ermitteln
    ZeileMax = Import.UsedRange.Rows.Count
    ZeileMax = CDbl(Zahl1) + CDbl(ZeileMax)
         
    'Change the name "Import" according to your sheet name.
    Set shtImport = Sheets("Import")
    
    'Change the delimited character "," according to your own needs.
    'NOTE: Due to the code structure only one character is accepted
    '      for delimited character (example "%", "-", "|" etc.).
    strDelChar = ";"
    
    '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
    
    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
    
    'Open the CSV file.
    On Error Resume Next
    Open strFileName For Input As #1
    
    'Check if the file was opened.
    If Err <> 0 Then
        MsgBox "File not found: " & strFileName, vbCritical, "Error"
        Exit Sub
    End If
    On Error GoTo 0
    
    'Initializing the variables.
    lRow = 0
    lCol = 0
    strText = ""
    
    'Activate the A1 cell on Import sheet.
    shtImport.Activate
    Range("A" & ZeileMax).Activate
    
    'Loop through all lines of CSV file and import the data values to the active sheet.
    Do Until EOF(1)
    
        'Pass the line data to a variable.
        Line Input #1, vntData
        
        'Loop through all characters of the variable.
        For lCharCount = 1 To Len(vntData)
            
            'Examine each character separately.
            strChar = Mid(vntData, lCharCount, 1)
            
            'If reach the delimited character write the value to a cell.
            If strChar = strDelChar Then
                ActiveCell.Offset(lRow, lCol) = strText
                lCol = lCol + 1
                strText = ""
            
            'If reache the end of the line write the (last) value to a cell and
            'then reset the strText variable.
            ElseIf lCharCount = Len(vntData) Then
                If strChar <> Chr(34) Then strText = strText & strChar
                ActiveCell.Offset(lRow, lCol) = strText
                strText = ""
                
            'In any other case concatenate the character with the strText variable.
            ElseIf strChar <> Chr(34) Then
                strText = strText & strChar
            End If
        Next lCharCount
        
        'Reset the variables for the next line of data.
        lCol = 0
        lRow = lRow + 1
        
    Loop
    
    'Close the CSV file.
    Close #1
    
'   Duplikate entfernen
    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
    ZeileMax1 = .UsedRange.Rows.Count
    
    For Row = ZeileMax1 To 4 Step -1
    
    If Application.WorksheetFunction.CountA(.Rows(Row)) = 0 Then
     .Rows(Row).Delete
    End If
Next Row
End With


'Dim arrIst, arrSoll, x
''
''Split-Funktion
''Gibt ein nullbasiertes, eindimensionales Datenfeld zurück,
''das eine festgelegte Anzahl an untergeordneten Zeichenfolgen enthält.
''Split(Zeichenfolge, Trennzeichen)
''
''einen individuellen Vergleich basteln
''denn nicht jede Datenquelle benutzt die gleichen Sonderzeichen
''
'arrIst = Split("„,”,,Ž,™,š,á", ",")
'arrSoll = Split("ä,ö,ü,Ä,Ö,Ü,ß", ",")
''
'For x = 0 To UBound(arrIst)
'  Cells.Replace What:=arrIst(x), _
'    Replacement:=arrSoll(x), _
'    LookAt:=xlPart, _
'    SearchOrder:=xlByRows, _
'    MatchCase:=True, _
'    SearchFormat:=False, _
'    ReplaceFormat:=False
'Next x


    ' ScreenUpdate aktivieren
    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
28.06.2014 21:36:43 Tribal
NotSolved
28.06.2014 22:52:38 Gast74988
NotSolved
29.06.2014 02:30:07 Gast89069
NotSolved
Blau Excel VBA - Zeichenkette suchen und ersetzten
29.06.2014 16:41:14 Tribal
NotSolved
29.06.2014 17:42:01 Gast19313
NotSolved
29.06.2014 20:48:26 Tribal
NotSolved
29.06.2014 21:43:54 Gast11929
NotSolved
29.06.2014 21:46:08 Gast96854
*****
Solved
29.06.2014 23:37:35 Tribal
Solved