Hallo allerseit,

letzte Woche wurde mir bereits mit einem Code hier im Forum geholfen (http://www.vba-forum.de/Forum/View.aspx?ziel=32819-Mein_Code_ist_zu_kompliziert_bzw._zu_lang). Vielen Dank an dieser Stelle nochmal für die schnelle Hilfe!

Jetzt habe ich jedoch bemerkt, dass er einige Nachteile mit sich bringt. Er Überträgt bestimmte Werte von einem Tabellenblatt in ein anderes. Dabei "zerschießt" es mir Formeln im Zieltabellenblatt (Tabelle1), obwohl diese nicht überschrieben werden sollte. Anstelle der ursprünglichen Formeln sind nun jedoch Werte angegeben (Betroffen sind die Zellen der Spalte K, und die Zeilen 13, 16, 18 und 19 in Tabelle 1.

Wie kann ich das verhindern?

Kurze Hintergrundinfos zur Mappe an sich, welche ich aus Datenschutzgründen leider nicht veröffentlichen darf:

Die Tabelle 1 umfasst insgesamt ca 260 Spalten und 460 Zeilen. In den oberen ca, 17 Zeilen der Tabelle 1 Tabellen sind in den Spalten 13 Bis 263 Mitarbeiter mit bestimmten Daten vermerkt, in den Spalten 3 Bis 10 sind projektdaten von 400 Projekten in den Zeilen 52-455 vermerkt. Die Datei dient der Zuordnung von mitarbeiter-arbeitszeit zu den jeweiligen Projekten. Diese sind in dem Bereich Zelle(M52:JB455) jeweils vermerkt oder eben auch leer. Die Tabelle 2 ist gleich aufgebaut aber umfasst nur eine Auswahl der Projekte und Mitarbeiter nach einem bestimmten Kriterium (sozusagen Abteilung). Die Angaben zur Arbeitszeit der einzelnen Mitarbeiter in den jeweiligen Projekten in tabelle2 sollen deshalb geändert weden können und anschließend mit dem Code in Tabelle1 "einsortiert" werden können. Es kann theoretisch immer nur ein Treffer pro Projekt/Mitarbeiter vorkommen, da alle projejte und Mitarbeiter jeweils nur ein mal vorkommen.

Ich hoffe das war halbwegs verständlich!:)

Anbei der Code:



 

Private Sub CommandButton1_Click()

If ActiveSheet.Range("M52", "JB251").NumberFormat <> "#," Then

MsgBox "Die Daten müssen in T€ angegeben sein, um ins Interface übertragen werden zu können! Bitte schalten Sie die Anzeige daher um."
 
 Unload Me
 
Else

Dim tab1
Dim tab2
Dim lspalte As Long     'Spalte in Tabelle 2
Dim pspalte As Long     'Spalte in Tabelle 1
Dim azeile As Long      'Zeile in Tabelle 2
Dim bzeile As Long      'Zeile in Tabelle 1
Dim spaltenanfang As Long 'ist der Anfang der Spalten hier Spalte 13
Dim zeilenanfang As Long  'ist der Anfang der Zeilen hier Zeile 52
Dim zeilenende As Long
Dim spaltenende As Long
 
'erstmal die Bildschirmaktualisierung ausschalten , für mehr Rechenleistung
Application.ScreenUpdating = False
 
'allgemeine Werte
spaltenanfang = 13
spaltenende = 263
zeilenanfang = 52
zeilenende = 251
 
'die Eintragungen in den Zwischenspeicher
tab1 = Tabelle1.Range(Tabelle1.Cells(1, 1), Tabelle1.Cells(zeilenende, spaltenende)) '263
tab2 = Tabelle2.Range(Tabelle2.Cells(1, 1), Tabelle2.Cells(zeilenende, spaltenende))
 
For pspalte = spaltenanfang To spaltenende
'durch alle Spalten in Tabelle 1 gehen, in Spalte 13 startn
    For lspalte = spaltenanfang To spaltenende
    'durch alle Spalten in Tabelle 2 gehen
        If tab2(5, lspalte) = tab1(5, pspalte) Then
        'Mitarbeiter wurde gefunden, der kommt später nicht nochmal, also nach dem Abarbeiten die Schleife in Tabelle 2 verlassen
            'jetzt bei dem Mitarbeiter die ersten Werte kopieren, könnte man noch in eine Schleife auslagern
            tab1(5, pspalte) = tab2(5, lspalte)
            tab1(7, pspalte) = tab2(7, lspalte)
            tab1(8, pspalte) = tab2(8, lspalte)
            tab1(9, pspalte) = tab2(9, lspalte)
            tab1(10, pspalte) = tab2(10, lspalte)
            tab1(11, pspalte) = tab2(11, lspalte)
            tab1(14, pspalte) = tab2(14, lspalte)
            tab1(15, pspalte) = tab2(15, lspalte)
            tab1(17, pspalte) = tab2(17, lspalte)
             
            For bzeile = zeilenanfang To zeilenende
            'jetzt noch von Zeile 52 bis 251 die Zeilen durchgehen und in Spalte 5 die Werte vergleichen, in Tabelle 1 starten
                For azeile = zeilenanfang To zeilenende
                'prüfen ob die Eintragungen identisch in der Zeile sind
                    If tab2(azeile, 5) = tab1(bzeile, 5) And tab2(azeile, 7) = tab1(bzeile, 7) Then
                        tab1(bzeile, pspalte) = tab2(azeile, lspalte)
                    End If
                Next azeile
            Next bzeile
 
            Exit For 'beendet die Schleife und geht in die nächse pspalte
        End If
    Next lspalte
Next pspalte
 
'die geänderten Eintragungen zurück
Tabelle1.Range(Tabelle1.Cells(1, 1), Tabelle1.Cells(251, 156)) = tab1
Application.ScreenUpdating = True

MsgBox "Die Änderungen wurden erfolgreich ins Interface übertragen!"
End If
End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub Label1_Click()

End Sub

Vielen Dank für eure Hilfe!