Ausführungszeit

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi,
danke für die Antwort ;-)
Hier mal die genaue Beschreibung:
1. die Ausführungszeit verbessern
2. ich verwende den eingefügten Code
3. er läuft, ist halt langsam
Habe das jetzt so gelöst:
Dim avarArray(1 To 150) As Variant
For k = 7 To 150
temp = Cells(12, k).Value
For o = 1 To 150
If temp = Sheets("Temp").Cells(o, 1).Value Then
'Cells(CInt(inp), k).Value = Sheets("Temp").Cells(o, 3).Value
avarArray(k) = Sheets("Temp").Cells(o, 3).Value
End If
Next o
Next k
For u = 7 To UBound(avarArray)
Cells(CInt(inp), u) = avarArray(u)
Next u
Ich wollte das Bsp(Link) verwenden, um die Ausführungsgeschwindigkeit des Makros zu erhöhen, da die Cells-Methode etwas langsam war(wegen der 2 for-Schleifen).
Gruß Andi

Hallo
Mit "Was willst du erreichen" dachte ich eigentlich eher an eine Beschreibung wie deine Tabelle aufgebaut ist und was du haben willst.
Ich muss mir nun anhand deines Codes, der langsam und anscheinend fehlerhaft ist ("...Es schreibt mir nicht dahin, wo ich will......"), herausfinden was du erreichen willst.
Wo kommt denn plötzlich das Array her ?
Anyway, .. mangels Kenntnis deines Tabellenaubaus mal hier eine Variante

Option Explicit

Sub Optimized()
    Dim srcWks As Worksheet, srcArea As Range, fndRange As Range
    Dim tarWks As Worksheet
    Dim tmpAddress As String
    Dim colStart As Integer, colEnd As Integer, chkRow As Long
    Dim i As Integer, inpRow As Long
    'Hier sollen die Daten hin
    Set tarWks = Worksheets("Daten")
    'Von hier kommen die Daten
    Set srcWks = Worksheets("Temp")
    'Suchbereich in der Tabelle wo die Daten herkommen
    Set srcArea = srcWks.Range("A1:A150")
    '=Schleifenzähler
    colStart = 7
    colEnd = 150
    'Aus welcher Zelle sollen die Daten gesucht werden
    chkRow = 12
    'On Error Resume Next
    'In welche Zeile sollen die Daten geschrieben werden
    inpRow = Cint(InputBox("In welche Zeile sollen die Daten", "Schreibe...", 5))
    If Not IsNumeric(inpRow) Then
        MsgBox "Falsche Zeile angegeben"
        Exit Sub
    End If
    '**************************************
    'Nichts mehr ändern ab hier
    For i = colStart To colEnd
        With tarWks
            'Sucht nach dem Begriff auf volle Übereinstimmung
            Set fndRange = srcArea.Find(what:=.Cells(chkRow, i), LookIn:=xlValues, lookat:=xlWhole)
            'Wenn gefunden...
            If Not fndRange Is Nothing Then
                '... eintragen in die Zelle
                .Cells(inpRow, i) = fndRange.Offset(0, 2).Value
            End If
        End With
    Next i
End Sub

Gruss Rainer

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread