|
Dim arrA(), arrN()
Sub Test()
Dim xn, zn, ra
With Sheets("Alt")
arrA = .Range(.Cells(4, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 16).Value
End With
With Sheets("Neu")
.Range(.Cells(4, 1), .Cells(.Rows.Count, 1).End(xlUp)).Offset(, 11).Resize(, 5).Value = 0
arrN = .Range(.Cells(4, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 16).Value
For xn = 1 To UBound(arrN, 1)
Tust xn
Next xn
.Cells(4, 1).Resize(UBound(arrN, 1), UBound(arrN, 2)).Value = arrN
For xn = 1 To UBound(arrN, 1)
Tast xn
Next xn
.Cells(4, 1).Resize(UBound(arrN, 1), UBound(arrN, 2)).Value = arrN
End With
End Sub
Sub Tast(rc)
Dim xn, xa, ya, zy, flag
For xn = rc To UBound(arrN, 1)
If arrN(xn, 12) = 0 Then
For xa = 1 To UBound(arrA, 1)
flag = False
For ya = 1 To 11
If arrA(xa, ya) <> arrN(xn, ya) Then flag = True
Next ya
If flag = False Then
For zy = 12 To 16
arrN(xn, zy) = arrA(xa, zy)
Next zy
Exit Sub
End If
Next xa
End If
Next xn
End Sub
Sub Tust(rw)
Dim xa, ya, zy, flag
For xa = rw To UBound(arrN, 1)
flag = False
For ya = 1 To 11
If arrA(xa, ya) <> arrN(rw, ya) Then flag = True
Next ya
If flag = False Then 'hit and replace
For zy = 12 To 16
arrN(xa, zy) = arrA(xa, zy)
Next zy
Exit For
End If
Next xa
End Sub
|