Hallo Anton,
du kannst entweder einen Wert in eine Zelle schreiben oder eine Formel. Steht in einer Zelle ein Wert, dann kannst du diesen Wert nicht mit einer Formel überschreiben. Das Verbessern von eingegebenen Werten kannst du nur über ein Makro machen.
Zu deinem Problem mit den sich nicht verschiebenden Einngaben habe ich mal etwas gebastelt.
Ergänze im VBA-Projekt der Arbeitsmappe die folgenden Zeilen:
'Makro zum Einlesen der Daten wird aufgerufen
Call einlesen
In das VBA-Projekt der Tabelle "DATEN" kopiere den folgenden Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngSpalte As Long
If Not Intersect(Target, Range("R:S")) Is Nothing Then
lngSpalte = Target.Column
Call Abgleich(lngSpalte)
End If
End Sub
In ein Standardmodul deiner Arbeitsmappe kopiere den folgenden Code:
Global arrDatenA As Variant
Global arrDatenB As Variant
Global strTabelleA As String
Global strTabelleB As String
Sub einlesen()
Dim lngLetzte As Long
Dim z As Long
'Namen der Ergebnistabellen festlegen
strTabelleA = "Ergebnisliste A"
strTabelleB = "Ergebnisliste B"
'Daten aus Ergebnisliste A einlesen, erst ab Zeile 10
With ThisWorkbook.Worksheets(strTabelleA)
'Blattschutz aufheben
.Unprotect
'letzte Zelle mit einem Eintrag in Spalte C suchen
For z = 10 To .Cells(Rows.Count, 3).End(xlUp).Row
If .Cells(z, 3).Value = "" Then
lngLetzte = z - 1
Exit For
End If
Next z
'Daten in Array einlesen
arrDatenA = .Range(.Cells(10, 3), .Cells(lngLetzte, 31))
'Blattschutz wieder setzen
.Protect
End With
'Daten aus Ergebnisliste b einlesen, erst ab Zeile 10
With ThisWorkbook.Worksheets(strTabelleB)
.Unprotect
'letzte Zelle mit einem Eintrag in Spalte C suchen
For z = 10 To .Cells(Rows.Count, 3).End(xlUp).Row
If .Cells(z, 3).Value = "" Then
lngLetzte = z - 1
Exit For
End If
Next z
'Daten in Array einlesen
arrDatenB = .Range(.Cells(10, 3), .Cells(lngLetzte, 31))
.Protect
End With
End Sub
Sub Abgleich(lngSpalte As Long)
Dim strName As String
Dim arrDaten As Variant
Dim lngLetzte As Long
Dim d As Long
Dim s As Long
Dim z As Long
'Eingabe in Spalte R, dann aus Ergebnisliste B die Daten auslesen
If lngSpalte = 18 Then
strName = strTabelleB
arrDaten = arrDatenB
Else
'sonst Ergebnisliste A auswählen
strName = strTabelleA
arrDaten = arrDatenA
End If
'Nun Spalten G bis U vergleichen und Werte übernehmen
With Worksheets(strName)
'Blattschutz aufheben
.Unprotect
'letzte Zelle mit einem Eintrag in Spalte C suchen
For z = 10 To .Cells(Rows.Count, 3).End(xlUp).Row
If .Cells(z, 3).Value = "" Then
lngLetzte = z - 1
Exit For
End If
Next z
'vorhande Inhalte der Spalten G bis U löschen
.Range(.Cells(10, 7), .Cells(.UsedRange.SpecialCells(xlCellTypeLastCell).Row, 21)).ClearContents
'nun vorhandene Daten zurückschreiben
For z = 10 To lngLetzte
'Abgleich der Nummern
For d = 1 To UBound(arrDaten, 1)
If .Cells(z, 3).Value = arrDaten(d, 1) Then
For s = 5 To 19
.Cells(z, s + 2) = arrDaten(d, s)
Next s
Exit For
End If
Next d
Next z
'Blattschutz wieder aktivieren
.Protect
End With
'Datenblätter wieder neu einlesen
Call einlesen
End Sub
Probiere mal einer Kopie deiner Mappe aus, ob der Code so funktioniert, wie du willst.
Gruß
M.O.