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

Ansicht des Beitrags:
Von:
Gast12000		 Datum:
13.04.2016 12:31:03		 Views:
808		 Rating:
     
Antwort:
  Ja
Thema:
Messwerte einlesen

Hallo!

Habe mal versucht den Code umzuschreiben. Ist aber ungetestet, da ich die Ausgangsdateien nicht habe. Da ich mir nicht sicher war, bin ich davon ausgegangen, dass der Code aus deiner Übersicht (die auch das Ziel vom Kopieren ist) gestartet wird. Ich habe die zwei Funtionen zusammengefügt, das öffnen der Ziedatei rausgenommen, die Zuordnung der Sheets geändert und zwei Sachen umgestellt. Den COde einfach der Schaltfläche zuweisen. Müsste eigentlich klappen. Viele Grüße

?
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
67
68
69
70
71
72
73
74
75
76
77
78
Sub eineSpalte()
 
 
 Dim objWSSource As Worksheet
 Dim objWSTarget As Worksheet
 
 ' das sollte deine Übersicht sein
 Set objWSTarget = ActiveSheet
  Application.ScreenUpdating = False
'
' 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
    'nach dem öffnen ist das aktiv und dient als quelle
    Set objWSSource = ActiveSheet
     
   '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
   'ziel aktivieren um später nicht überrascht zu werden, falls eine andere mappe noch auf ist
    objWSTarget.activate
      
   'Quelldatei ohne Speichern schließen
   objWSSource.Parent.Close False
    
    
   'Runden
 
   For Each cell In [A1:K8]
       cell.Value = WorksheetFunction.Round(cell.Value, 3)
   Next cell
    
   'Ordner Tabellen leeren
   Kill "xxx\*.txt"
    
    'Bilschirmaktualisierung einschalten
   Application.ScreenUpdating = True
     
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
13.04.2016 09:35:07 Gast24153
NotSolved
Blau Messwerte einlesen
 13.04.2016 12:31:03 Gast12000
NotSolved
21.04.2016 11:18:21 Gast93218
Solved