AW: automatisieren
12.02.2009 10:30:00
Tino
Hallo,
dies können wir mit der Sverweis Formel machen.
Sub TestLeseTxT()
Dim sFormel As String, sPfad As String
Dim rLetzte As Range
Dim WertAusTxT, WertAusExcel
'Auswahldialog für Textdatei oder festen Pfad angeben
sPfad = Application.GetOpenFilename("Text Files (*.txt), *.txt")
If sPfad <> "Falsch" Then
'letzte Zelle in AA
Set rLetzte = Cells(Rows.Count, "AA")
'Sverweis Formel: Pfad, Dateinamen und Tabellennamen anpassen
sFormel = "VLOOKUP(TODAY(),'C:\Neuer Ordner\[Mappe2.xls]Tabelle1'!R1C1:R65536C27,27,FALSE)"
WertAusExcel = ExecuteExcel4Macro(sFormel)
WertAusTxT = LeseZeile1(sPfad)
If IsNumeric(WertAusTxT) And IsNumeric(WertAusExcel) Then
MsgBox WertAusExcel * WertAusTxT & Chr(13) & Chr(13) & _
"Wert aus Textdatei: " & WertAusTxT & Chr(13) & _
"Wert aus Exceldatei: " & WertAusExcel, vbInformation, "Ergebnis"
Else
MsgBox "Die Daten konnten nicht berechnet werden!"
End If
End If
End Sub
Function LeseZeile1(strPfad As String) As Double
Dim sLine As String
Dim F As Integer
F = FreeFile
Open strPfad For Input As #F
Line Input #F, sLine
Close #F
sLine = Replace(sLine, " ", vbTab)
If InStr(sLine, vbTab) > 0 Then
sLine = Right$(sLine, Len(sLine) - InStr(sLine, vbTab))
End If
sLine = Replace(Trim$(sLine), ".", IIf("0.5" * 1 = 1, ".", ","))
If IsNumeric(sLine) Then
LeseZeile1 = CDbl(sLine)
End If
End Function
Gruß Tino