hi georg :-)

Sub test()
'wie sind die variablen deklariert
For z1 = 2 To 6
    For s1 = 2 To 6
        For z2 = 10 To 14
            If Cells(z1, s1) = Cells(z2, s1) Then 'wo war das then
                For s2 = 2 To 6
                    If Cells(h1, s1) = Cells(h2, s2) Then 'wo war das then,wo ist die tabellenzuweisung
                        If Cells(z1, s1) = 1 Then 'wo war das then ,wo ist die tabellenzuweisung
                        Set Cells(z2, s2) = 1 'wozu die objektvariable (set),besser so Cells(z2, s2) = 1 ,wo ist die tabellenzuweisung
                        End If
                    End If
                Next s2 'wo war das next
            End If
       Next z2 'wo war das next
  Next s1 'wo war das next
Next z1 'wo war das next
End Sub

'erstmal testen auf lauffaehigkeit und performance
'sollte die performance nicht zufriedendstellend sein ,dann nutze statt des direkten zugriffs auf die zellen lieber ein array
'4 schleifen kommen mir auch ein wenig viele vor

'tabellenzuweisungen

Sub Tab1()
With Worksheet("Tabelle1")
.Cells(Var, Var) = 1 'durch den vorrangestellten punk wird nun bezug zur with anwesung genommen bzw. zur angegebenen tabelle
End With
End Sub

'oder so

Sub Tab2()
Dim Wks1 As Worksheet
Set Wks1 = Worksheet("Tabelle2")
Wks1.Cells(Var, Var) = 1
End Sub

'jetzt uebe erstmal ein wenig ,du hast bisher ja nicht mal getestet deinen code

'hier noch ein netter link fuer variablen

http://de.wikibooks.org/wiki/VBA_in_Excel_-_Grundlagen:_Namenskonve...

bei fragen,immer raus damit :-)

gruss nighty

hi georg

hier noch ein mini eispiel eines arrays was den zugriff extrem beschleunugen wuerde

Sub Beispiel()
    ReDim intArray(Range("A" & Rows.Count).End(xlUp).Row, 1) As Variant
    intArray() = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
    Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row) = intArray()
End Sub

dazu ergaenzend lbound und ubound bitte mal anschauen wie auch redim preserve

bei obigen makro koennte man der uebersichtlickeit wegen diese zeile noch einer variablen uebergeben ,die dann als long deklariert sein sollte

LetzteZeileWks1=Range("A" & Rows.Count).End(xlUp).Row

dann hier noch ein paar tips fuer letzte zellen ermittlung

Sub Letzte()
Rem letzte zeile eines sheets
a = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Rem letze spalte eines sheets
b = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
Rem letzte zeile einer spalte
c = ActiveSheet.Range("D" & Rows.Count).End(xlUp).Row
Rem letzte spalte einer zeile
d = ActiveSheet.Range("3:3").End(xlToRight).Column
End Sub

nun versuche mal deinen code mit einem array zugestalten

gruss nighty

hi nighty ,

Vielen Dank für deine Antwort. Das mit dem Arrays habe ich mir auch überlegt. Ich wusste aber nicht wie kann man das realisieren. Kannst du mir vielleicht ein tipp geben wie kann ich das benutzen in mein Code?
Ich weiß das 4 Schleifen viel sind. Das Problem ist das die Schlüsselfelder von Tab1 und Tab2 vertauscht sind. und ich wusste nicht wie könnte man die Gleichheitsprüfung sonst realisieren konnte.

ich werde es jetzt probieren und geben dann Feedback

viele Grüße,

Georg

hi georg :-)

wobei viele zellen sind es ja nicht habe ich bemerkt,also waere deine idee schon ok gewesen

hier ein ansatz mit einem array

kontrolliere die variablen,da ich nur vermuten konnte

es wird jeweils von tabelle1 wie tabelle2 ein bereich in ein array gelegt
nach deinen optionen verglichen
nach beendigung der schleifen wird das 2 array zur tabelle2 zurueckgeschrieben

wie gesagt basiert alles auf vermutungen

beachte das du parallelen zugriff zu beiden arrays hast und du dadurch eventuell mit 2 schleifen auskommst

alles erstmal als ansatz zu betrachten

gruss nighty

Option Explicit
Option Base 1
Sub test()
    Dim z1 As Integer, z2 As Integer, s1 As Integer, s2 As Integer
    ReDim Arr1(5, 5) As Variant
    ReDim Arr2(5, 5) As Variant
    Sheets(2).Activate
    Arr2() = Range("B2:F6")
    Sheets(1).Activate
    Arr1() = Range("B10:F14")
    For z1 = 1 To 5
        For s1 = 1 To 5
            For z2 = 1 To 5
                For s2 = 1 To 5
                    If Arr1(z1, s1) = Arr2(z2, s2) Then
                        If Arr1(z1, s1) = 1 Then
                            Arr2(z2, s2) = 1
                        End If
                    End If
                Next s2
            Next z2
        Next s1
    Next z1
    Sheets(2).Activate
    Range("B2:F6") = Arr2()
    Sheets(1).Activate
End Sub