AW: Werte aus anderer Tabelle übernehmen
19.03.2008 12:16:31
fcs
Hallo Willy,
Prozedur muss etwa so aussehen, wobei du zum Blatt 2 ja nicht viel geschrieben hast.
Gruß
Franz
Sub DatenUebertragen()
Dim ws1 As Worksheet, wsB1 As Worksheet, wsB2 As Worksheet
Dim z&, z1&, zB1&, zB2& 'Long-Variablen
Dim Spalte%
Dim Tank As String
Dim Chemikalie As String
Dim Menge As Double
Dim NiveauDiff As Variant
Dim DatumNeu As Date, DatumAlt As Date
Set ws1 = Worksheets("Tabelle1")
Set wsB1 = Worksheets("Blatt 1")
Set wsB2 = Worksheets("Blatt 2")
z1 = 5 '1. Daten Zeile in tabelle 1
zB1 = 6 '1. Leerzeile in Blatt 1
zB2 = 5 '1. Leerzeile in Blatt 2
wsB1.Range("A6:U30").ClearContents
wsB2.Range("A5:T30").ClearContents
DatumAlt = ws1.Cells(z1, 1).Value
For z = z1 To ws1.Cells(ws1.Rows.Count, 1).End(xlUp)
DatumNeu = ws1.Cells(z, 1).Value
Tank = ws1.Cells(z, 6).Value
Chemikalie = ws1.Cells(z, 5).Value
Menge = ws1.Cells(z, 10).Value
NiveauDiff = ws1.Cells(z, 9).Value
If Chemikalie = "Stoff" Then
wsB2.Cells(zB2, 1) = DatumNeu
wsB2.Cells(zB2, 3) = Menge
zB2 = zB2 + 1
Else
If DatumNeu DatumAlt Then
zB1 = zB1 + 1
DatumAlt = DatumNeu
End If
Select Case Chemikalie
Case "Oxid"
If Tank = "1" Then
wsB1.Cells(zB1, 1).Value = DatumNeu
wsB1.Cells(zB1, 2).Value = Menge
wsB1.Cells(zB1, 3).Value = NiveauDiff
ElseIf Tank = "2" Then
wsB1.Cells(zB1, 1).Value = DatumNeu
wsB1.Cells(zB1, 4).Value = Menge
wsB1.Cells(zB1, 5).Value = NiveauDiff
Else
MsgBox "Fehler bei Tanknummer in Tabelle 1 in Zeile " & z
End If
Case "Lauge"
If Tank = "1" Then
wsB1.Cells(zB1, 1).Value = DatumNeu
wsB1.Cells(zB1, 6).Value = Menge
wsB1.Cells(zB1, 7).Value = NiveauDiff
ElseIf Tank = "2" Then
wsB1.Cells(zB1, 1).Value = DatumNeu
wsB1.Cells(zB1, 8).Value = Menge
wsB1.Cells(zB1, 9).Value = NiveauDiff
Else
MsgBox "Fehler bei Tanknummer in Tabelle 1 in Zeile " & z
End If
Case "Base 1"
If Tank = "1" Then
wsB1.Cells(zB1, 1).Value = DatumNeu
wsB1.Cells(zB1, 10).Value = Menge
wsB1.Cells(zB1, 11).Value = NiveauDiff
Else
MsgBox "Fehler bei Tanknummer in Tabelle 1 in Zeile " & z
End If
Case "Base 2"
If Tank = "2" Then
wsB1.Cells(zB1, 1).Value = DatumNeu
wsB1.Cells(zB1, 12).Value = Menge
wsB1.Cells(zB1, 13).Value = NiveauDiff
Else
MsgBox "Fehler bei Tanknummer in Tabelle 1 in Zeile " & z
End If
Case "Säure 1"
If Tank = "1" Then
wsB1.Cells(zB1, 1).Value = DatumNeu
wsB1.Cells(zB1, 14).Value = Menge
wsB1.Cells(zB1, 15).Value = NiveauDiff
Else
MsgBox "Fehler bei Tanknummer in Tabelle 1 in Zeile " & z
End If
Case "Säure 2"
If Tank = "2" Then
wsB1.Cells(zB1, 1).Value = DatumNeu
wsB1.Cells(zB1, 16).Value = Menge
wsB1.Cells(zB1, 17).Value = NiveauDiff
Else
MsgBox "Fehler bei Tanknummer in Tabelle 1 in Zeile " & z
End If
Case "Aluminiumsulfat"
If Tank = "1" Then
wsB1.Cells(zB1, 1).Value = DatumNeu
wsB1.Cells(zB1, 18).Value = Menge
wsB1.Cells(zB1, 19).Value = NiveauDiff
Else
MsgBox "Fehler bei Tanknummer in Tabelle 1 in Zeile " & z
End If
Case "Zusatz"
If Tank = "1" Then
wsB1.Cells(zB1, 1).Value = DatumNeu
wsB1.Cells(zB1, 20).Value = Menge
wsB1.Cells(zB1, 21).Value = NiveauDiff
Else
MsgBox "Fehler bei Tanknummer in Tabelle 1 in Zeile " & z
End If
Case Else
'do nothing
End Select
End If
Next
End Sub