Thema Datum  Von Nutzer Rating
Antwort
20.10.2016 09:06:09 Soeren
Solved
20.10.2016 09:52:51 Gast21762
Solved
20.10.2016 10:05:42 Gast11739
NotSolved
20.10.2016 12:24:30 Soeren
NotSolved
20.10.2016 12:41:09 Gast17228
NotSolved
20.10.2016 12:53:57 Soeren
NotSolved
21.10.2016 20:09:12 Soeren
NotSolved
21.10.2016 21:06:22 Gast12128
NotSolved
21.10.2016 21:28:39 Soeren
NotSolved
21.10.2016 21:31:46 Gast34914
NotSolved
21.10.2016 21:41:28 Soeren
NotSolved
21.10.2016 21:43:54 Gast46205
NotSolved
21.10.2016 21:55:32 Soeren
NotSolved
21.10.2016 21:56:11 Gast88705
NotSolved
21.10.2016 22:14:34 Gast54181
NotSolved
21.10.2016 22:24:10 Gast87829
NotSolved
21.10.2016 23:02:13 Gast3420
NotSolved
21.10.2016 23:02:14 Gast13888
NotSolved
21.10.2016 23:32:51 Soeren
NotSolved
21.10.2016 22:45:57 Soeren
NotSolved
21.10.2016 22:24:55 Gast7307
NotSolved
21.10.2016 22:39:56 Soeren
NotSolved
21.10.2016 22:42:13 Soeren
NotSolved
21.10.2016 23:01:44 Soeren
NotSolved
22.10.2016 10:43:01 Gast52308
NotSolved
23.10.2016 11:02:53 Soeren
NotSolved
23.10.2016 12:15:25 Gast20296
NotSolved
23.10.2016 16:49:48 Soeren
NotSolved
23.10.2016 18:57:13 Gast67743
NotSolved
23.10.2016 19:22:01 Soeren
NotSolved
23.10.2016 19:29:16 Soeren
NotSolved
23.10.2016 19:30:40 Soeren
NotSolved
23.10.2016 19:42:28 Soeren
NotSolved
23.10.2016 19:49:10 Soeren
NotSolved
23.10.2016 20:09:18 Gast41213
NotSolved
23.10.2016 20:16:08 Soeren
NotSolved
23.10.2016 20:17:13 Soeren
NotSolved
23.10.2016 20:18:08 Soeren
NotSolved
23.10.2016 20:39:02 Gast78227
NotSolved
23.10.2016 21:04:41 Soeren
NotSolved
23.10.2016 21:21:25 Soeren
NotSolved
23.10.2016 22:49:15 Gast40653
NotSolved
23.10.2016 23:01:19 Soeren
NotSolved
24.10.2016 09:42:45 Gast18846
NotSolved
24.10.2016 10:54:39 Soeren
NotSolved
Blau CSV ab zweiter Zeile nach Excel importieren
24.10.2016 12:28:23 Soeren
NotSolved
24.10.2016 14:18:15 Soeren
NotSolved
24.10.2016 21:49:01 Gast82902
NotSolved
24.10.2016 22:04:59 Gast58318
NotSolved
24.10.2016 22:41:58 Soeren
NotSolved
24.10.2016 22:44:25 Soeren
NotSolved
24.10.2016 22:58:20 Soeren
Solved

Ansicht des Beitrags:
Von:
Soeren
Datum:
24.10.2016 12:28:23
Views:
959
Rating: Antwort:
  Ja
Thema:
CSV ab zweiter Zeile nach Excel importieren

Ich habe mich jetzt für ein Formular entschieden und habe alle Bezüge angepasst. Das Makro schreibt jetzt brav alle Daten an die richtige Stelle der Tabelle.

Das einzigste was jetzt noch stört, ist das alles in Anführungszeichen kommt und das die Umlaute falsch dargestellt werden...gibt es dafür eine Lösung???

Hier jetzt noch mal der fertige 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
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
Sub ReadfromCSVSimple(fname As Variant, Optional fs As String = ";")
       
        Dim hfile     As Integer   ' Filehandle bzw. Dateinummer
        Dim lAnzahl   As Long      ' Zähler über alle Zeilen
        Dim OneLine   As String    ' eine Zeile als String
        Dim myArr     As Variant   ' eine Zeile in Felder getrennt
        Dim myArrRows As Variant  ' Array zum Trennen des csv in mehrere Zeilen
        Dim lnglast   As Long
        Dim zeichen   As Variant
        Dim iCnt      As Integer  'Schleifenzaehler fuer Array. Bei vielen Daten Long nehmen
        Dim inhalt
      
        ThisWorkbook.Worksheets("Projektübersicht").Select
                 
        lnglast = Cells(Rows.Count, 1).End(xlUp).Row
                 
        If IsEmpty(Cells(lnglast, 1)) Then lnglast = Cells(lnglast, 1).End(xlUp).Row
                 
        lnglast = lnglast + 1 ' ermittelt die erste freie Zeile
                 
        hfile = FreeFile
         
        Open fname For Input As #hfile
        
        inhalt = Input(LOF(hfile), hfile)        ' liest alles ein
       
        Close #hfile
            
        If UBound(Split(inhalt, Chr(10))) > 0 Then MsgBox inhalt Else Exit Sub
                                                    
        inhalt = Replace(inhalt, Split(inhalt, Chr(10))(0), 1, 1)
           
           
        OneLine = inhalt 'die zweite zeile
         
     
        If OneLine <> "" Then MsgBox OneLine Else MsgBox "die zweite Zeile ist leer"            ' ist die Zeile NICHT leer, dann zeige den Inhalt, sonst sag das sie leer ist
                 
        myArr = Split(OneLine, ";")
                                                          
        If UBound(myArr) > 49 Then 'es gibt also 44 Einträge geben , 0 und dan bis 43 = 44, Minimum sind 43
                  
         With Worksheets("Projektübersicht")
             
        .Cells(lnglast, 3) = Replace(myArr(20), Chr$(49), vbNullString) 'Name/ BV
        .Cells(lnglast, 4) = Replace(myArr(22), Chr$(49), vbNullString) 'Land/ BV
        .Cells(lnglast, 18) = Replace(myArr(22), Chr$(49), vbNullString) 'Land/ BV
        .Cells(lnglast, 7) = Replace(myArr(23), Chr$(49), vbNullString) ' Straße/ BV
        .Cells(lnglast, 21) = Replace(myArr(23), Chr$(49), vbNullString) ' Straße/ BV
        .Cells(lnglast, 5) = Replace(myArr(24), Chr$(49), vbNullString) ' PLZ/ BV
        .Cells(lnglast, 19) = Replace(myArr(24), Chr$(49), vbNullString) ' PLZ/ BV
        .Cells(lnglast, 6) = Replace(myArr(25), Chr$(49), vbNullString) 'Ort/ BV
        .Cells(lnglast, 20) = Replace(myArr(25), Chr$(49), vbNullString) 'Ort/ BV
        .Cells(lnglast, 16) = Replace(myArr(26), Chr$(49), vbNullString) ' Ansprechpartner/ BV
        .Cells(lnglast, 22) = Replace(myArr(27), Chr$(49), vbNullString) ' Telefon/ BV
        .Cells(lnglast, 23) = Replace(myArr(29), Chr$(49), vbNullString) ' Mail/ BV
         
        .Cells(lnglast, 9) = Replace(myArr(11), Chr$(49), vbNullString)  ' Abwicklung über: Firma/ Name
        .Cells(lnglast, 8) = Replace(myArr(12), Chr$(49), vbNullString)  ' Abwicklung über: Ansprechpartner
        .Cells(lnglast, 10) = Replace(myArr(13), Chr$(49), vbNullString) ' Abwicklung über: Land
        .Cells(lnglast, 13) = Replace(myArr(14), Chr$(49), vbNullString) ' Abwicklung über Straße
        .Cells(lnglast, 11) = Replace(myArr(15), Chr$(49), vbNullString) ' Abwicklung über PLZ:
        .Cells(lnglast, 12) = Replace(myArr(16), Chr$(49), vbNullString) ' Abwicklung über Ort
        .Cells(lnglast, 14) = Replace(myArr(17), Chr$(49), vbNullString) ' Abwicklung über Telefon:
        .Cells(lnglast, 15) = Replace(myArr(19), Chr$(49), vbNullString) ' Abwicklung über Mail
         
        .Cells(lnglast, 33) = Replace(myArr(2), Chr$(49), vbNullString)  ' Auftraggeber: Firma/ Name
        .Cells(lnglast, 38) = Replace(myArr(3), Chr$(49), vbNullString)  ' Auftraggeber: Ansprechpartner
        .Cells(lnglast, 34) = Replace(myArr(4), Chr$(49), vbNullString)  ' Auftraggeber: Land
        .Cells(lnglast, 37) = Replace(myArr(5), Chr$(49), vbNullString)  ' Auftraggeber: Straße
        .Cells(lnglast, 35) = Replace(myArr(6), Chr$(49), vbNullString)  ' Auftraggeber: PLZ:
        .Cells(lnglast, 36) = Replace(myArr(7), Chr$(49), vbNullString)  ' Auftraggeber: Ort
        .Cells(lnglast, 39) = Replace(myArr(8), Chr$(49), vbNullString)  ' Auftraggeber: Telefon
        .Cells(lnglast, 40) = Replace(myArr(10), Chr$(49), vbNullString) ' Auftraggeber: Mail
                         
         
        .Cells(lnglast, 31) = "Objekt:" & " " & Replace(myArr(30), Chr$(49), vbNullString) _
         & vbCrLf & "Objekthersteller:" & " " & Replace(myArr(31), Chr$(49), vbNullString) _
         & vbCrLf & "Objektalter:" & " " & Replace(myArr(32), Chr$(49), vbNullString) _
         & vbCrLf & "Trägermaterial:" & " " & Replace(myArr(33), Chr$(49), vbNullString) _
         & vbCrLf & "Oberfläche:" & " " & Replace(myArr(34), Chr$(49), vbNullString) _
         & vbCrLf & "Farbsystem-Nr.:" & " " & Replace(myArr(35), Chr$(49), vbNullString) _
         & vbCrLf & "Glanzgrad:" & " " & Replace(myArr(36), Chr$(49), vbNullString) _
         & vbCrLf & "Schadensumfang:" & " " & Replace(myArr(37), Chr$(49), vbNullString) _
         & vbCrLf & "Schadensort:" & " " & Replace(myArr(38), Chr$(49), vbNullString) _
         & vbCrLf & "Schadensursache:" & " " & Replace(myArr(39), Chr$(49), vbNullString) & vbCrLf & "Schadensbeschreibung:" & " " & Replace(myArr(40), Chr$(49), vbNullString)
                  
              
         End With
                
         lnglast = lnglast + 1
          
         MsgBox "erfolgreich eingetragen"
          
         Kill fname
          
         End If
             
           
         
          
         
         
           
       
    End Sub
       
       
       
       
       
    Private Sub CommandButton1_Click()
    Dim Dateiname  As Variant
       
       
    Dateiname = Application.GetOpenFilename(filefilter:="Textdateien (*.csv), *.csv")
          
          
    If Dateiname <> "Falsch" Or Dateiname <> False Then
           
    Else
           
    Exit Sub
           
    End If
           
           
    Call ReadfromCSVSimple(Dateiname, ";")
          
    Unload UserForm3
    End Sub
       
       
Private Sub CommandButton2_Click()
Unload Me
UserForm4.Show
End Sub
       
Private Sub CommandButton3_Click()
Unload Me
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
20.10.2016 09:06:09 Soeren
Solved
20.10.2016 09:52:51 Gast21762
Solved
20.10.2016 10:05:42 Gast11739
NotSolved
20.10.2016 12:24:30 Soeren
NotSolved
20.10.2016 12:41:09 Gast17228
NotSolved
20.10.2016 12:53:57 Soeren
NotSolved
21.10.2016 20:09:12 Soeren
NotSolved
21.10.2016 21:06:22 Gast12128
NotSolved
21.10.2016 21:28:39 Soeren
NotSolved
21.10.2016 21:31:46 Gast34914
NotSolved
21.10.2016 21:41:28 Soeren
NotSolved
21.10.2016 21:43:54 Gast46205
NotSolved
21.10.2016 21:55:32 Soeren
NotSolved
21.10.2016 21:56:11 Gast88705
NotSolved
21.10.2016 22:14:34 Gast54181
NotSolved
21.10.2016 22:24:10 Gast87829
NotSolved
21.10.2016 23:02:13 Gast3420
NotSolved
21.10.2016 23:02:14 Gast13888
NotSolved
21.10.2016 23:32:51 Soeren
NotSolved
21.10.2016 22:45:57 Soeren
NotSolved
21.10.2016 22:24:55 Gast7307
NotSolved
21.10.2016 22:39:56 Soeren
NotSolved
21.10.2016 22:42:13 Soeren
NotSolved
21.10.2016 23:01:44 Soeren
NotSolved
22.10.2016 10:43:01 Gast52308
NotSolved
23.10.2016 11:02:53 Soeren
NotSolved
23.10.2016 12:15:25 Gast20296
NotSolved
23.10.2016 16:49:48 Soeren
NotSolved
23.10.2016 18:57:13 Gast67743
NotSolved
23.10.2016 19:22:01 Soeren
NotSolved
23.10.2016 19:29:16 Soeren
NotSolved
23.10.2016 19:30:40 Soeren
NotSolved
23.10.2016 19:42:28 Soeren
NotSolved
23.10.2016 19:49:10 Soeren
NotSolved
23.10.2016 20:09:18 Gast41213
NotSolved
23.10.2016 20:16:08 Soeren
NotSolved
23.10.2016 20:17:13 Soeren
NotSolved
23.10.2016 20:18:08 Soeren
NotSolved
23.10.2016 20:39:02 Gast78227
NotSolved
23.10.2016 21:04:41 Soeren
NotSolved
23.10.2016 21:21:25 Soeren
NotSolved
23.10.2016 22:49:15 Gast40653
NotSolved
23.10.2016 23:01:19 Soeren
NotSolved
24.10.2016 09:42:45 Gast18846
NotSolved
24.10.2016 10:54:39 Soeren
NotSolved
Blau CSV ab zweiter Zeile nach Excel importieren
24.10.2016 12:28:23 Soeren
NotSolved
24.10.2016 14:18:15 Soeren
NotSolved
24.10.2016 21:49:01 Gast82902
NotSolved
24.10.2016 22:04:59 Gast58318
NotSolved
24.10.2016 22:41:58 Soeren
NotSolved
24.10.2016 22:44:25 Soeren
NotSolved
24.10.2016 22:58:20 Soeren
Solved