also alle Datumse...
21.11.2010 20:06:33
Erich
Hi Stephan,
probier mal
Option Explicit
Sub Datum_rueber()
Dim lngA As Long, arrDa, arrKd, arrRe, arrKE, arrDE()
Dim zz As Long, cc As Long, ss As Long, lngS As Long
With Sheets("Tabelle1")
lngA = .Cells(.Rows.Count, 1).End(xlUp).Row
arrDa = .Range(.Cells(3, 1), .Cells(lngA, 1))
arrKd = .Range(.Cells(3, 8), .Cells(lngA, 8))
For zz = 1 To UBound(arrKd)
If Len(arrKd(zz, 1)) > 0 Then arrKd(zz, 1) = CLng(arrKd(zz, 1))
Next zz
End With
With Sheets("Tabelle3")
arrRe = .Range(.Cells(3, 4), .Cells(1, 1).SpecialCells(xlLastCell))
lngS = UBound(arrRe, 2)
End With
With Sheets("Tabelle2")
lngA = .Cells(.Rows.Count, 1).End(xlUp).Row
arrKE = .Range(.Cells(3, 1), .Cells(lngA, 1))
ReDim arrDE(1 To lngA - 2, 1 To lngS)
For zz = 1 To lngA - 2
For cc = 1 To lngS
arrDE(zz, cc) = ""
Next cc
Next zz
For zz = 1 To UBound(arrKd)
If Len(arrKd(zz, 1)) > 0 Then
For cc = 1 To lngS
If IsEmpty(arrRe(zz, cc)) Then Exit For
For ss = 1 To UBound(arrKd)
If arrKd(ss, 1) = arrRe(zz, cc) Then
arrDE(zz, cc) = arrDa(ss, 1)
Exit For
End If
Next ss
Next cc
End If
Next zz
.Range(.Cells(3, 2), .Cells(lngA, lngS)) = arrDE
End With
End Sub
Deine Mappe krankt etwas daran, dass alle Nummern (ReNr, KdNr) Zahlen sind
außer in Tabelle1, Spalte H. Hier wird ein Text mit 5 Zeichen erzeugt. Das solltest du einheitlich halten -
IMMER Zahlen oder IMMER Texte.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort