PDA

Vollständige Version anzeigen : Formel als Function


Ic3
23.09.2016, 11:32
Hallo ich habe da eine tolle Formel welche die „Bestell-Nr“ zerlegt und mit dem Buchstabenkürzel in einer anderen Tabelle nachschaut welche Firma das ist.
Funktioniert gut, ist aber bei vielen tausend Zeilen ein absoluter Ressourcenfresser.

Meine Frage: Kann man das in einer Funktion schneller lösen?
Funktion: Schau nach rechts, zerlege die Nr und suche mit dem Buchstabenkürzel in einer Tabelle nach welche Firma das ist und schreibe diese in die Zelle
Die Buchstabenkürzel sind immer links und 1 bis 4 stellig.


Hier die Formel: {=INDEX(Betriebe!A:A;VERGLEICH(LINKS(B11;VERGLEICH(1;ISTZAHL(TEIL(B11;SPALTE(A11 :E11);1)*1)*1;0)-1);Betriebe!D:D;0))}
Würde im Recorder so ausehen: Range("A5").FormulaArray = "=INDEX(Betriebe!C,MATCH(LEFT(RC[1],MATCH(1,ISNUMBER(MID(RC[1],COLUMN(RC:RC[3]),1)*1)*1,0)-1),Betriebe!C[3],0))"

Habe auch eine Beispieldatei angehangen.

rastrans
23.09.2016, 14:12
Hallo,

das Problem, wenn du da wieder eine Formel einträgst, das diese Formel immer wieder berechnet wird. Wenn du die Felder fest in die Zele schreibst, dann wird das nur einmal berechnet.

in dem VBA-Bereich von ZusammenfassungPrivate Sub Worksheet_Change(ByVal Target As Range)
Dim strFirmaKurz As String
Dim i As Integer
Dim rng As Range

If Target.Column = 2 And Target.Count = 1 Then
i = 1
Do Until IsNumeric(Mid(Target.Value, i)) Or i > Len(Target.Value)
i = i + 1
Loop
strFirmaKurz = Left(Target.Value, i - 1)
Set rng = Worksheets("Betriebe").Columns(4).Find(What:=strFirmaKurz, LookAt:=xlWhole)
Application.EnableEvents = False
If Not rng Is Nothing Then
Target.Offset(0, -1).Value = rng.Offset(0, -3).Value
Else
Target.Offset(0, -1).Value = "#Not found#"
End If
Application.EnableEvents = True
End If
End Sub

Ic3
24.09.2016, 10:37
Danke schon mal. Es startet praktisch bei einer Eingabe, dass ist für mich bedingt gut.
Ich wollte die Daten per Makro in der Zusammenfassung einsammeln.
Kann man das auch so gestalten das die Schleife immer direkt nach dem "Kopier-Makro" gestartet wird und Spalte 1 durchsucht ob da etwas steht?

rastrans
25.09.2016, 12:15
Hallo,

hier die Prozedur nun mal so, das alle Daten ersetzt werden. Wann du diese Prozedur aufrufen möchtest, bleibt dann dir überlassen.

Viele Grüße
rastransSub FirmennameEintragen()
Dim lngZeile As Long
Dim strFirmaKurz As String
Dim i As Integer
Dim rng As Range

lngZeile = 11
Do Until lngZeile > Cells(Rows.Count, 2).End(xlUp).Row
strFirmaKurz = Cells(lngZeile, 2).Value
If Len(strFirmaKurz) Then
i = 1
Do Until IsNumeric(Mid(strFirmaKurz, i)) Or i > Len(strFirmaKurz)
i = i + 1
Loop
strFirmaKurz = Left(strFirmaKurz, i - 1)
Set rng = Worksheets("Betriebe").Columns(4).Find(What:=strFirmaKurz, LookAt:=xlWhole)
If Not rng Is Nothing Then
Cells(lngZeile, 1).Value = rng.Offset(0, -3).Value
Else
Cells(lngZeile, 1).Value = "#Not found#"
End If
End If
lngZeile = lngZeile + 1
Loop
End Sub

Ic3
25.09.2016, 14:29
Vielen Dank für die Mühe!!!! :top:
Es funktioniert und macht genau das was es soll. Ich muss mir jetzt nur noch überlegen ab welcher Stelle ich es einsetze. Denn einen Moment dauert es ja doch.