Textimport mit VBA??!!
19.12.2003 08:10:16
Timo
ich habe folgendes Problem. Über eine Auswertesoftware generiere ich ein Textfile. Dieses soll nun in Excel importiert und weiterverarbeitet werden. So Weit so Gut. Bisher hatte ich 132 Spalten. Nun aber wird die Textdatei auf 383 Spalten erweitert.
Da meine VBA Kenntnisse noch relativ gering sind, habe ich den Import mit dem Makrorekorder aufgezeichnet. Hierbei kam die Fehlermeldung (Bei den 132 Spalten) dass er nicht genug array informationen in ein Zeile VBA Code bekommt. Also habe ich per Hand nachgeholfen. Bei nun aber 383 Spalten ist das zu viel und zu aufwendig.
Gibt es eine andere Möglichkeit den Text zu importieren? Kann ich die Anzahl der Spalten evtl dynamisch gestalten?
Vielen Dank im voraus für Eure Hilfe.
Gruß,
Timo
Anbei der VBA Code:
Sub Mittelwertverteilung()
' Mittelwertverteilung Makro
' Makro am 13.11.2003 von Timo Paul aufgezeichnet
Dim Dateiname, Blattname, Blattname2 As String
Workbooks.Open Filename:="D:\Projekte\Cathlean\Messergebnisse\Auswertung\Mittelwert.xlt"
Blattname = ActiveWorkbook.Name
Dateiname = Application.GetOpenFilename()
On Error GoTo Errorhandler
Workbooks.OpenText Filename:=Dateiname _
, Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=True, 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), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 1), Array(34, 1), _
Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array(46, 1), Array(47, 1), _
Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array(59, 1), Array(60, 1), _
Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1), Array(65, 1), Array(66, 1), Array(67, 1), Array(68, 1), Array(69, 1), Array(70, 1), Array(71, 1), Array(72, 1), Array(73, 1), _
Array(74, 1), Array(75, 1), Array(76, 1), Array(77, 1), Array(78, 1), Array(79, 1), Array(80, 1), Array(81, 1), Array(82, 1), Array(83, 1), Array(84, 1), Array(85, 1), Array(86, 1), _
Array(87, 1), Array(88, 1), Array(89, 1), Array(90, 1), Array(91, 1), Array(92, 1), Array(93, 1), Array(94, 1), Array(95, 1), Array(96, 1), Array(97, 1), Array(98, 1), Array(99, 1), _
Array(100, 1), Array(101, 1), Array(102, 1), Array(103, 1), Array(104, 1), Array(105, 1), Array(106, 1), Array(107, 1), Array(108, 1), Array(109, 1), Array(110, 1), Array(111, 1), _
Array(112, 1), Array(113, 1), Array(114, 1), Array(115, 1), Array(116, 1), Array(117, 1), Array(118, 1), Array(119, 1), Array(120, 1), Array(121, 1), Array(122, 1), Array(123, 1), _
Array(112, 1), Array(113, 1), Array(124, 1), Array(125, 1), Array(126, 1), Array(127, 1), Array(128, 1), Array(129, 1), Array(130, 1), Array(131, 1), Array(132, 1)), _
DecimalSeparator:=",", ThousandsSeparator:=".", TrailingMinusNumbers:=True
Application.DisplayAlerts = False
Blattname2 = ActiveWorkbook.Name
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("A1:EB105").Select
Selection.Copy
Workbooks(Blattname).Activate
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A2").Select
Workbooks(Blattname2).Close
ActiveWindow.SmallScroll Down:=105
Range("A123").Select
ActiveCell.FormulaR1C1 = "Mittelwert"
Range("A124").Select
ActiveCell.FormulaR1C1 = "Standardab."
Range("A126").Select
ActiveCell.FormulaR1C1 = "SMP"
Range("B123").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(R[-121]C[-1]:R[-17]C[130])"
Range("B124").Select
ActiveCell.FormulaR1C1 = "=STDEV(R[-122]C[-1]:R[-18]C[130])"
Range("B126").Select
ActiveCell.FormulaR1C1 = "=R[-2]C/R[-3]C"
Range("B127").Select
Application.DisplayAlerts = True
ActiveWorkbook.SaveAs Filename:="Mittelwertverteilung.xls"
Errorhandler:
End Sub