AW: Daten von Eingabeblatt in verschiedene Tabellen
09.07.2013 13:22:12
Eingabeblatt
Hallo Micha,
nachfolgend ein entsprechendes Makro, das die Daten aus dem Messprotokoll in die Brunnendateien übertragt.
Mir ist aufgefallen, dass du in den Brunnenblättern und im Messprotokoll zum Teil unterschiedliche Berechnungsformeln verwendest, z.B. bei Norm-Gasmenge.
Dadurch gibt es Formelfehler wenn z.B. der Saugdruck ("-/-" im Messprotokoll) in das Brunneblatt übertragen wird.
Das musst du noch bereinigen. Alternativ kannst du natürlich die Formeln in den Brunnenblätter weglassen und die berechneten Werte aus dem Messprotokoll eintragenlassen.
Gruß
Franz
Sub MessprotokollDaten_uebertragen()
Dim wkbProtokoll As Workbook, wksProtokoll As Worksheet
Dim SpaltePro As Long, varBrunnen
Dim wkbBrunnen As Workbook, wksBrunnen As Worksheet
Dim strPath As String, strDateiName As String
Dim Zeile As Long, Spalte As Long
Set wkbProtokoll = ActiveWorkbook
Set wksProtokoll = wkbProtokoll.Worksheets("Daten")
strPath = wkbProtokoll.Path 'Verzeichnis mit den Dateien der Brunnen (gleiches _
wie Messprotokolle) ggf. anpassen
With wksProtokoll
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
For SpaltePro = 2 To 23
varBrunnen = .Cells(5, SpaltePro)
strDateiName = ""
Select Case varBrunnen
Case 1: strDateiName = "Brunnen 1.xls"
Case 2: strDateiName = "Brunnen 2.xls"
'für Brunnen 3 bis 22 entsprechende Zeilen einfügen
Case Else
'do nothing
End Select
If strDateiName "" Then
Set wkbBrunnen = Application.Workbooks.Open(Filename:=strPath & "\" & strDateiName)
Set wksBrunnen = wkbBrunnen.Worksheets("Daten")
With wksBrunnen
Spalte = .Cells(5, .Columns.Count).End(xlToLeft).Column + 1
.Cells(5, Spalte) = wksProtokoll.Range("B2")
For Zeile = 6 To 25
Select Case Zeile
Case 6 To 8
.Cells(Zeile, Spalte) = wksProtokoll.Cells(Zeile, SpaltePro)
Case 9 'N2
.Cells(Zeile, Spalte).FormulaR1C1 = "=100-R[-3]C-R[-2]C-R[-1]C"
Case 10 'Rohrinnendurchmesser
.Cells(Zeile, Spalte) = wksProtokoll.Cells(11, SpaltePro)
Case 11 'Fließgeschwindigkeit
.Cells(Zeile, Spalte) = wksProtokoll.Cells(12, SpaltePro)
Case 12 'Gasmenge (m³ / h)
.Cells(Zeile, Spalte).FormulaR1C1 = _
"=R[-1]C*3600*R[-2]C*R[-2]C*3.1415/4/1000000*0.84"
Case 13 'Norm -Gasmenge(Nm³ / h)
.Cells(Zeile, Spalte).FormulaR1C1 = _
"=R[-1]C*((273/(273+R[2]C))*((1013+R[4]C)/1013.5))"
Case 14 'Energieinhalt (kW)
.Cells(Zeile, Spalte).FormulaR1C1 = "=9.9436*R[-8]C/100*R[-1]C"
Case 15 'Gastemperatur (°C)
.Cells(Zeile, Spalte) = wksProtokoll.Cells(16, SpaltePro)
Case 16 'rel. Gasfeuchtigkeit (%)
.Cells(Zeile, Spalte) = wksProtokoll.Cells(17, SpaltePro)
Case 17 'Saugdruck (mbar)
.Cells(Zeile, Spalte) = wksProtokoll.Cells(18, SpaltePro)
Case 18 'Außentemperatur (°C)
.Cells(Zeile, Spalte) = wksProtokoll.Cells(19, SpaltePro)
Case 19 'rel. Luftfeuchtigkeit (%)
.Cells(Zeile, Spalte) = wksProtokoll.Cells(20, SpaltePro)
Case 20 'Atmos.Druck (mbar)
.Cells(Zeile, Spalte) = wksProtokoll.Cells(21, SpaltePro)
Case 21 'Klappenstellung (°)
.Cells(Zeile, Spalte) = wksProtokoll.Cells(22, SpaltePro)
Case 22 'Klappenstellung nachher(°)
.Cells(Zeile, Spalte) = wksProtokoll.Cells(23, SpaltePro)
Case 23 'Betriebsstunden Zähler(h)
.Cells(Zeile, Spalte) = wksProtokoll.Cells(24, SpaltePro)
Case 24 'Bemerkung
.Cells(Zeile, Spalte) = wksProtokoll.Cells(25, SpaltePro)
Case 25 'Bemerkung
.Cells(Zeile, Spalte) = wksProtokoll.Cells(26, SpaltePro)
Case Else
'do nothing
End Select
Next
End With
Application.DisplayAlerts = False
wkbBrunnen.Close savechanges:=True
Application.DisplayAlerts = True
End If
Next
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End With
Set wkbBrunnen = Nothing: Set wksBrunnen = Nothing
Set wkbProtokoll = Nothing: Set wksProtokoll = Nothing
End Sub