AW: Teile des Zelleninhalt auslesen
06.10.2005 10:17:08
Daniel
Hi
Irgendwas haut in meinen code immer nochnicht hin. Er sagt jedes mal das da keine 2.0 drinne steht. Ich poste mal den ganzen Code der über einen Button auf gerufen wird.
Danke Daniel
Private Sub Import_Click()
'On Error Resume Next
'Application.FindFile 'öffnet dialogfeld datei öffnen
sfile = Application.GetOpenFilename("alle Dateien (*.*), *.*") 'öffnet Dialogfenster "Datei öffnen"
If sfile = False Then 'If Abfrage wenn Cancel gedrückt
GoTo Ende 'keine Datei ausgewählt, auf Abbrechen geklickt
Else
Workbooks.Open sfile
'Sheets(1).Select
If Right(Range("A2"), 3) = "2.0" Then --- hier Prüfung ob 2.0 ---
Sheets(1).Select
Sheets(1).Copy After:=Workbooks("Auswertung.xls").Sheets(1)
Sheets(2).Name = "Daten"
Worksheets("Daten").Columns("A:A").Select
Sheets("Daten").Select
If Range("B2").Value = "" _
Then
Application.DisplayAlerts = False
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, 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)), TrailingMinusNumbers:=True
Application.DisplayAlerts = False
Worksheets("Daten").Columns("c:c").Select
Selection.ColumnWidth = 9.44
Else
Worksheets("Daten").Columns("c:c").Select
Selection.ColumnWidth = 9.44
End If
Sheets("Daten").Activate
Sheets("Daten").Copy Before:=Sheets(2)
Sheets("Daten (2)").Select
Sheets("Daten (2)").Move Before:=Sheets(4)
Sheets("Daten (2)").Select
Sheets("Daten (2)").Name = "ungültige Transaktionen"
Dim v As Long
Dim Anzahl As Long
With Sheets("Daten")
Anzahl = .Cells(Rows.Count, 1).End(xlUp).Row
For v = Anzahl To 6 Step -1
If Not .Cells(v, 1).Value = "TRS0001I" Then .Rows(v).Delete
Next v
End With
Dim ws As Worksheet
Dim Zeilen As Long
Dim r As Long
Set ws = Sheets("ungültige Transaktionen")
With ws
Zeilen = .Cells(Rows.Count, 1).End(xlUp).Row
For r = Zeilen To 6 Step -1
If .Cells(r, 1).Value = "TRS0001I" Then
.Rows(r).EntireRow.Delete
End If
Next r
End With
Else
MsgBox ("Sie haben eine falsche Datei ausgewählt. Die Auswertung wird abgebrochen")
ActiveWindow.Close
GoTo Ende
End If
End If
Ende:
End Sub