Werte suchen und zuordnen

17/09/2008 - 17:12 von FRANZ LUWEIN | Report spam
Hallo alle,

Auf meinem wsSL stehen in Spalte B Namen.
Auf meinem wsDaten stehen in
in Spalte A Ziffern (1-10),
in den Spalten B:E und AC:AF Namen
in den Spalten K:N und AL:AO Werte

Die Werte, die zu den Namen gehören stehen jeweils 9 Spalten weiter
rechts. Diese Werte muss ich auslesen und im wsSL in verschiedene
Spalten (3 + Nummer) der Zeile mit dem passenden Namen in eintragen.

Das oben beschriebene erledigt der folgende Code.
Das funktioniert zwar, dauert jedoch sehr lange.

Könnte man das nicht beschleunigen?

Mit freundlichem Gruß

Franz


For Each Zelle1 In unionRange

WerteSP = Zelle1.Column + 9
ZeileDaten = Zelle1.Row

If wsDaten.Range("A" & ZeileDaten).Value <= UF_SL.SL_Nummer.Value Then

strName = Zelle1.Value
Werte = wsDaten.Cells(ZeileDaten, WerteSP).Value
Nummer = wsDaten.Cells(ZeileDaten, 1).Value

For Each Zelle2 In rngNamen

If Zelle2.Value = strName Then
wsSL.Cells(Zelle2.Row, 3 + Nummer).Value = Werte
Exit For
End If
Next
End If

Next
 

Lesen sie die antworten

#1 Peter Schleif
17/09/2008 - 20:40 | Warnen spam
FRANZ LUWEIN schrieb am 17.09.2008 17:12 Uhr:

Könnte man das nicht beschleunigen?



Du könntest die innere Schleife auch über eine schnelle
WorksheetFunction realisieren (Find,Match,...). Deine Bereiche
"unionRange" und "rngNamen" kannte ich nicht. Vieles im untenstehenden
Code ist daher geraten.

Wenn Du Code postest, der so viele Variablen enthàlt, solltest Du die
Variablen auch mit Testwerten besetzten oder gleich die ganze Mappe
hochladen. Woher sollen wir wissen, was in "UF_SL.SL_Nummer.Value"
steht? Ich habe es einfach mal auf 5 gesetzt:

Peter

Sub WerteSuchen_Peter()
Dim unionRange As Range
Dim rngNamen As Range
Dim found As Range
Dim zelle As Range

Set unionRange = Sheets("wsDaten").[B1:E10,AC1:AF10]
Set rngNamen = Sheets("wsSL").[B1:B10]

For Each zelle In unionRange
If zelle.EntireRow.Resize(,1) <= 5 And zelle <> "" Then
Set found=rngNamen.Find(What:=zelle.Value,Lookat:=xlWhole)
If Not found Is Nothing Then
found.Select
Sheets("wsSL").Cells(found.Row, 3 + zelle.EntireRow _
.Resize(,1)).Value = zelle.Offset(,9).Value
End If
End If
Next
End Sub

Ähnliche fragen