Brauche wieder Hilfe beim Messwerte einlesen
#1
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]


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
Antworten Top
#2
Hallöchen,

ich bin jetzt etwas unsicher, wo sich Dein Blatt "Übersicht" befindet und wann z.B. das AktiveSheet das Blatt Übersicht ist bzw wo das liegt. In der Zieldatei, die nicht mehr ausgewählt werden soll, oder anderswo?

Ich nehme jetzt mal nur den Part, dass eine Datei im letzten code nicht mehr ausgewählt werden soll und gehe dabei davon aus, dass die trotzdem noch geöffnet werden soll. Es muss also der Name fest programmiert werden. Das könnte dann so aussehen. Ich hab mal noch das Kopieren und Einfügen über eine Schleife gelöst, da wird der code etwas kürzer, dafür allerdings etwas undurchschaubarer :-)

Der Button befindet sich in der offenen Datei, dem weist Du das erste von Deinen 3 Makros zu.

Mit dem kleinen Makro am Ende kannst Du übrigens kontrollieren, ob meine "Abkürzung" beim Kopieren und Einfügen die richtigen Zellbereiche berücksichtigt :-)

Modul Modul1
Public Sub CopyData1() '1 Merkmal 
 Dim objWSSource As Worksheet, objWSTarget As Worksheet 
 Dim strFile As String 
 Dim iCnt% 
 'ChDrive ("S:\") 
 'ChDir ("S:\QS\NONE-Prüfprotokolle\Vorlagen\") 
 'strFile = Application.GetOpenFilename("Exceldateien (*.xlsx;*.xlsm;*.xls),*.xlsx;*.xlsm;*.xls", , "Zieldatei wählen...") 
 strFile = "Zieldatei" '<-- Dateiname programmieren, inklusive Pfad zur Datei! 
 'If Not CVar(strFile) = False Then '<-- Pruefung so nicht mehr noetig 
 If Dir(strFile) <> "" Then '<-- Neue Pruefung, falls Datei nicht vorhanden ist. 
   Set objWSSource = ActiveSheet '<-- Ist das Blatt Uebersicht, wenn dort der Button ist 
   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 
   For iCnt = 1 To 8 
     'kopiert $F$2:$F$12 $F$13:$F$23 $F$24:$F$34 $F$35:$F$45 $F$46:$F$56 $F$57:$F$67 $F$68:$F$78 $F$79:$F$89 
     'nach $A$1:$K$1 $A$2:$K$2 $A$3:$K$3 $A$4:$K$4 $A$5:$K$5 $A$6:$K$6 $A$7:$K$7 $A$8:$K$8 
     objWSTarget.Range(Cells(iCnt, 1), Cells(iCnt, 11)).Value = objWSSource.Range(Cells(2 + (iCnt - 1) * 11, 6), Cells(12 + (iCnt - 1) * 11, 6)).Value 
   Next 
   '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 
 
Sub test() 
   For iCnt = 1 To 8 
     Debug.Print Range(Cells(iCnt, 1), Cells(iCnt, 11)).Address 
     Debug.Print Range(Cells(2 + (iCnt - 1) * 11, 6), Cells(12 + (iCnt - 1) * 11, 6)).Address 
   Next 
End Sub 

.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#3
(13.03.2016, 12:14)schauan schrieb: Hallöchen,

ich bin jetzt etwas unsicher, wo sich Dein Blatt "Übersicht" befindet und wann z.B. das AktiveSheet das Blatt Übersicht ist bzw wo das liegt. In der Zieldatei, die nicht mehr ausgewählt werden soll, oder anderswo?

Ich nehme jetzt mal nur den Part, dass eine Datei im letzten code nicht mehr ausgewählt werden soll und gehe dabei davon aus, dass die trotzdem noch geöffnet werden soll. Es muss also der Name fest programmiert werden. Das könnte dann so aussehen. Ich hab mal noch das Kopieren und Einfügen über eine Schleife gelöst, da wird der code etwas kürzer, dafür allerdings etwas undurchschaubarer Smile
Was meinst du mit "Übersicht"? Ich habe eine TXT also Quelle aus der die Werte ausgelesen werden. Und statt bisher diese in eine Datei zu schreiben die Ich erst aussuchen kann, sollen sie direkt in das offene Arbeitsblatt geschrieben werden. Also in das in dem auch der Button um die Makros zu starten ist - in den roten Bereich im Blid das ich angehängt habe. Der Teil unten mit "Es wurde keine Datei ausgewählt" kann ja weg in dem fall.
Antworten Top
#4
Ich hab den Code jetzt mal eingefügt, leider kommt dann die Meldung, dass die Datei schon geöffnet ist und Daten verloren gehen wenn ich erneut öffne, dann wird die txt exportiert und dann stürzt Excel ab.
Antworten Top
#5
Hallöchen,

ich dachte, Du meinst mit "und in eine Übersicht" ein Blatt mit diesem Namen.

Hier mal der geänderte Code. Beide Dateien sind dabei offen, beim Start des codes bist Du auf dem Zielblatt. oben in der Zeile mit const musst Du noch den Dateinamen ändern.

Public Sub CopyData2() '1 Merkmal 
 Const strSourceBook As String = "Export.csv"
 Dim objWSSource As Worksheet, objWSTarget As Worksheet
 Dim iCnt%
 Set objWSSource = Windows(strSourceBook).ActiveSheet
 Set objWSTarget = ActiveSheet
 Application.ScreenUpdating = False
 '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
 For iCnt = 1 To 8
   'kopiert $F$2:$F$12 $F$13:$F$23 $F$24:$F$34 $F$35:$F$45 $F$46:$F$56 $F$57:$F$67 $F$68:$F$78 $F$79:$F$89
   'nach $A$1:$K$1 $A$2:$K$2 $A$3:$K$3 $A$4:$K$4 $A$5:$K$5 $A$6:$K$6 $A$7:$K$7 $A$8:$K$8
   objWSTarget.Range(Cells(iCnt, 1), Cells(iCnt, 11)).Value = objWSSource.Range(Cells(2 + (iCnt - 1) * 11, 6), Cells(12 + (iCnt - 1) * 11, 6)).Value
 Next
 Application.ScreenUpdating = True
 'Runden
 For Each cell In [A1:K8]
   cell.Value = WorksheetFunction.Round(cell.Value, 3)
 Next cell
End Sub
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#6
So Jetzt bekommen ich den Fehler
Zitat:Laufzeitfehler '9':

Index außerhalb des gültigen Bereichs


Beim debuggen wird diese Zeile hervorgehoben:

Code:
Set objWSSource = Windows(strSourceBook).ActiveSheet
Antworten Top
#7
Hi,

(15.03.2016, 08:46)skafo schrieb: Beim debuggen wird diese Zeile hervorgehoben:
Code:
Set objWSSource = Windows(strSourceBook).ActiveSheet

Heißt die Quelldatei wirklich "Export.csv"?
Antworten Top
#8
(15.03.2016, 14:20)Rabe schrieb: Heißt die Quelldatei wirklich "Export.csv"?

Nein, aber das hab ich ja geändert. Die Quelldatei ist eine .txt
Antworten Top
#9
Hallöchen,

ich habe bei mir irgendwo eine Textdatei angelegt und im Excel geöffnet. Makro geht problemlos, wenn ich die codezeile entsprechend dem Namen der geöffneten Datei anpasse:
Const strSourceBook As String = "Neues Textdokument.txt"
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Antworten Top
#10
Hi,

(15.03.2016, 15:25)skafo schrieb: Nein, aber das hab ich ja geändert. Die Quelldatei ist eine .txt

darum fragte ich, denn im Code steht "Export.csv"! Hast Du das dort auch angepasst?
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste