Thema Datum  Von Nutzer Rating
Antwort
Rot Messwerte einlesen
 13.04.2016 09:35:07 Gast24153
NotSolved
13.04.2016 12:31:03 Gast12000
NotSolved
21.04.2016 11:18:21 Gast93218
Solved

Ansicht des Beitrags:
Von:
Gast24153		 Datum:
13.04.2016 09:35:07		 Views:
1470		 Rating:
     
Antwort:
  Ja
Thema:
Messwerte einlesen

Hallo alle zusammen,

Ich muss Messwerte die in eine txt geschrieben werden aus dieser auslesen und in eine Excel Übersicht einlesen. Bisher habe ich das Makro das ich habe 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.

Das mit den farben ist ja kein Problem, und woher die Daten kommen, wo sie ausgelesen werden sollen, und wo sie reingeschrieben werden sollen hab ich alles hingekriegt. Das einzige das ich jetzt noch brauche und nicht selber hinkriege ist, dass der Button zum ausführen des Makros im selben Blatt sein soll wie die Übersicht.


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.

http://i65.tinypic.com/lit90.jpg

?
1
2
3
4
Sub eineSpalte()
   merge_öffnen
   CopyData1
End Sub
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub merge_öffnen()
'
' Sammeldatei merge__chr.txt öffnen
   Workbooks.OpenText Filename:= _
       "xxx\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
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
Public Sub CopyData1() '1 Merkmal
 
 Dim objWSSource As Worksheet, objWSTarget As Worksheet
 Dim strFile As String
  
 ChDrive ("S:\")
 ChDir ("xxx\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 "xxx\*.txt"
    
 Else
   MsgBox "Es wurde keine Datei ausgewählt."
   Set objWSSource = ActiveSheet
   objWSSource.Parent.Close
 End If
End Sub

 

Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:
WYSIWYG-Editor, ctl00_Content_editor1



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
Rot Messwerte einlesen
 13.04.2016 09:35:07 Gast24153
NotSolved
13.04.2016 12:31:03 Gast12000
NotSolved
21.04.2016 11:18:21 Gast93218
Solved