09.03.2016, 12:37
Hallo alle zusammen,
der user Kuwer hat mir vor einer Weile dabei geholfen Messwerte aus einer txt Datei in eine Excel Tabelle einzulesen - nachzulesen hier http://www.clever-excel-forum.de/Thread-...e-kopieren
Bisher habe ich das Makro immer aus einer extra Excel Tabelle gestartet, da ich mehrere Schaltflächen für die jeweils zugehörige Anzahl von Messmerkmalen gebraucht habe.
Nun muss ich eine Reihenmessung machen, 88 Teile mit jeweils einem (und dem gleichen) Messmerkmal. Die Ergebnisse werden wieder in eine txt geschrieben und sollen von dort Ausgelesen und in eine Übersicht in Excel geschrieben werden. Diese stellt die Palette auf der die Teile liegen dar und jeder Platz soll sich, je nach dem ob der Messwert i.O. oder nicht ist, rot oder grün Färben.
Soweit hab ich alles hingekriegt auch den Code hab ich dementsprechend angepasst, das einzige was mir jetzt noch fehlt ist, dass die Schaltfläche zum starten des Makros im Selben Tabellenblatt sein soll wie die Übersicht, da ich ja jetzt nicht mehr mehrere Schaltflächen brauche. Auch die Zieldatei soll nicht mehr auswählbar sein.
Hier mal wie es aussieht und der original Code dazu, wäre nett wenn ihn mir jemand so abändern könnte, dass die Daten aus der txt ausgelesen und in die Übersicht reingeschrieben werden.
[Bild: lit90.jpg]
der user Kuwer hat mir vor einer Weile dabei geholfen Messwerte aus einer txt Datei in eine Excel Tabelle einzulesen - nachzulesen hier http://www.clever-excel-forum.de/Thread-...e-kopieren
Bisher habe ich das Makro immer aus einer extra Excel Tabelle gestartet, da ich mehrere Schaltflächen für die jeweils zugehörige Anzahl von Messmerkmalen gebraucht habe.
Nun muss ich eine Reihenmessung machen, 88 Teile mit jeweils einem (und dem gleichen) Messmerkmal. Die Ergebnisse werden wieder in eine txt geschrieben und sollen von dort Ausgelesen und in eine Übersicht in Excel geschrieben werden. Diese stellt die Palette auf der die Teile liegen dar und jeder Platz soll sich, je nach dem ob der Messwert i.O. oder nicht ist, rot oder grün Färben.
Soweit hab ich alles hingekriegt auch den Code hab ich dementsprechend angepasst, das einzige was mir jetzt noch fehlt ist, dass die Schaltfläche zum starten des Makros im Selben Tabellenblatt sein soll wie die Übersicht, da ich ja jetzt nicht mehr mehrere Schaltflächen brauche. Auch die Zieldatei soll nicht mehr auswählbar sein.
Hier mal wie es aussieht und der original Code dazu, wäre nett wenn ihn mir jemand so abändern könnte, dass die Daten aus der txt ausgelesen und in die Übersicht reingeschrieben werden.
[Bild: lit90.jpg]
Code:
Sub eineSpalte()
merge_öffnen
CopyData1
End Sub
Code:
Sub merge_öffnen()
'
' Sammeldatei merge__chr.txt öffnen
Workbooks.OpenText Filename:= _
"S:\QS\Zeiss\Tabellen\merge__chr.txt", _
Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
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), 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)), _
DecimalSeparator:=".", ThousandsSeparator:=",", TrailingMinusNumbers:= _
True
End Sub
Code:
Public Sub CopyData1() '1 Merkmal
Dim objWSSource As Worksheet, objWSTarget As Worksheet
Dim strFile As String
ChDrive ("S:\")
ChDir ("S:\QS\NONE-Prüfprotokolle\Vorlagen\")
strFile = Application.GetOpenFilename("Exceldateien (*.xlsx;*.xlsm;*.xls),*.xlsx;*.xlsm;*.xls", , "Zieldatei wählen...")
If Not CVar(strFile) = False Then
Set objWSSource = ActiveSheet
Application.ScreenUpdating = False
'Datei öffnen und Zieltabelle auswählen
Set objWSTarget = Workbooks.Open(strFile).Worksheets("Auswertung")
'Zellen Kopieren - Entweder einen ganzen Bereich z.B. Range("A1:A5") oder eine einzelne Zelle
'z.B. Range("A1") oder eben über den Namen einer Zelle oder Zellbereichs Range("CELLNAME")
'ggf. hier eine Schleife beginnen oder die nächsten Zeilen für jeden Datensatz einzeln
'aufrufen
'Zeile 1
objWSTarget.Range("A1:K1").Value = objWSSource.Range("F2:F12").Value
'Zeile 2
objWSTarget.Range("A2:K2").Value = objWSSource.Range("F13:F23").Value
'Zeile 3
objWSTarget.Range("A3:K3").Value = objWSSource.Range("F24:F34").Value
'Zeile 4
objWSTarget.Range("A4:K4").Value = objWSSource.Range("F35:F45").Value
'Zeile 5
objWSTarget.Range("A5:K5").Value = objWSSource.Range("F46:F56").Value
'Zeile 6
objWSTarget.Range("A6:K6").Value = objWSSource.Range("F57:F67").Value
'Zeile 7
objWSTarget.Range("A7:K7").Value = objWSSource.Range("F68:F78").Value
'Zeile 8
objWSTarget.Range("A8:K8").Value = objWSSource.Range("F79:F89").Value
'END COPY-PASTE-BLOCK
'Quelldatei ohne Speichern schließen
objWSSource.Parent.Close False
'Bilschirmaktualisierung einschalten
Application.ScreenUpdating = True
'Runden
Set objWSTarget = ActiveSheet
For Each cell In [A1:K8]
cell.Value = WorksheetFunction.Round(cell.Value, 3)
Next cell
'Ordner Tabellen leeren
Kill "S:\QS\Zeiss\Tabellen\*.txt"
Else
MsgBox "Es wurde keine Datei ausgewählt."
Set objWSSource = ActiveSheet
objWSSource.Parent.Close
End If
End Sub