Office Forum
www.Office-Loesung.de
Access :: Excel :: Outlook :: PowerPoint :: Word :: Office :: Wieder Online ---> provisorisches Office Forum <-
Code vereinfachen
zurück: Kopiercode verkürzen weiter: Exceldatei öffnen Unbeantwortete Beiträge anzeigen
Neues Thema eröffnen   Neue Antwort erstellen     Status: Antwort Facebook-Likes Diese Seite Freunden empfehlen
Zu Browser-Favoriten hinzufügen
Autor Nachricht
krokojo
Im Profil kannst Du frei den Rang ändern


Verfasst am:
19. Dez 2011, 07:01
Rufname:

Code vereinfachen - Code vereinfachen

Nach oben
       Version: Office 2003

Hallo zusammen,

Ich hoffe mir kann jemand mit meinem code helfen.
Ich habe versucht einen Querverweis mittels VBA zu schreiben,
nur dauert dieser verdammt lange.
Hier der Code:

Code:
Sub Makro()
Dim i As Long
Dim x As Long
Dim y As Long
Sheets("Werte").Activate
i = 3
x = 3
y = 5
Do While x <= 65536 And Sheets("Tab1").Cells(x, 1) <> ""
    Do While i <= 65536 And Cells(i, 33) <> ""
        If Cells(i, 34).Value Like "*" & Sheets("Tab1").Cells(x, 1).Text And Cells(i, 39).Value = Sheets("Tab1").Cells(x, 2).Value And Cells(i, 79) = Sheets("Tab1").Cells(x, 3).Value Then
            If Sheets("Tab1").Cells(x, 4) = "Welt" Then
                If Cells(i, 123) = "" Then
                    If Sheets("Tab1").Cells(2, y).Text Like "Markt*" Then
                        If Cells(i, 91) = "Markt" And Cells(i, 65) = "Groesse" Then
                            If Cells(i, 88).Value = Evaluate(Cells(i, 2).Text & Right(Sheets("Tab1").Cells(2, 5).Text, 2)) Then
                                Cells(i, 137).Copy Destination:=Sheets("Tab1").Cells(x, y)
                                x = x + 1
                                i = 3
                            End If
                        End If
                    ElseIf Sheets("Tab1").Cells(2, y).Text Like "Grund*" Then
                        If Cells(i, 65) = "Grund" And Cells(i, 64) <> "Daten" Then
                            If Cells(i, 88).Value = Evaluate(Cells(i, 2).Text & Right(Sheets("Tab1").Cells(2, 5).Text, 2)) Then
                                Cells(i, 137).Copy Destination:=Sheets("Tab1").Cells(x, y)
                                x = x + 1
                                i = 3
                            End If
                        End If
                    ElseIf Sheets("Tab1").Cells(2, y).Text Like "Verkauf*" Then
                        If Cells(i, 65) = "Verkauf" Then
                            If Cells(i, 88).Value = Evaluate(Cells(i, 2).Text & Right(Sheets("Tab1").Cells(2, 5).Text, 2)) Then
                                Cells(i, 137).Copy Destination:=Sheets("Tab1").Cells(x, y)
                                x = x + 1
                                i = 3
                            End If
                        End If
                    End If
                End If
            ElseIf Sheets("Tab1").Cells(x, 4).Value = Cells(i, 123).Value Then
                If Sheets("Tab1").Cells(2, y).Text Like "Markt*" Then
                    If Cells(i, 91) = "Markt" Or Cells(i, 65) = "Markt" Then
                        If Cells(i, 88).Value = Evaluate(Cells(i, 2).Text & Right(Sheets("Tab1").Cells(2, 5).Text, 2)) Then
                            Cells(i, 137).Copy Destination:=Sheets("Tab1").Cells(x, y)
                            x = x + 1
                            i = 3
                        End If
                    End If
                ElseIf Sheets("Tab1").Cells(2, y).Text Like "Verkauf*" Then
                    If Cells(i, 65) = "Verkauf" Then
                        If Cells(i, 88).Value = Evaluate(Cells(i, 2).Text & Right(Sheets("Tab1").Cells(2, 5).Text, 2)) Then
                            Cells(i, 137).Copy Destination:=Sheets("Tab1").Cells(x, y)
                            x = x + 1
                            i = 3
                        End If
                    End If
                End If
            End If
        End If
        i = i + 1
    Loop
    x = x + 1
    i = 3
Loop
End Sub


Wie bekomm ich den Code hin, dass es nicht mehr so lange dauert?
Vor allem weil ich ja noch den parameter "y" brauche um von Links nach Rechts zu springen.
(das ist bis jetz noch nicht im Code enthalten, vielleicht kann mir da dann auch noch jemand helfen)

Vielen Dank
MfG Johnny

Meine erste
Klaus-Dieter
Schwerpunktinteresse: VBA und UserForms


Verfasst am:
19. Dez 2011, 10:30
Rufname: Klaus
Wohnort: Sassenburg


AW: Code vereinfachen - AW: Code vereinfachen

Nach oben
       Version: Office 2003

Hallo Johnny,

ich habe es mir jetzt nicht angetan, das alles zu analysieren. Könnte mir aber vorstellen, das du mit einem Aufbau in dieser Art weiter kommst:

Select Case Sheets("Tab1").Cells(2, y)
    Case "Markt*"
        ' mach was 
    Case "Grund*"
        ' mach was 
    Case "Verkauf*"
        ' mach was 
End Select
Code eingefügt mit VBA in HTML 2.0.0.1

_________________
Viele Grüße
Klaus-Dieter
Lösungsvorschläge sind, wenn es keinen anders lautenden Hinweis gibt, von mir getestet.
Yoga ist besser, als rumsitzen und gar nichts machen.
Gerd L
Just for fun


Verfasst am:
19. Dez 2011, 23:02
Rufname:
Wohnort: Mannheim

AW: Code vereinfachen - AW: Code vereinfachen

Nach oben
       Version: Office 2003

Hallo Johnny,

Rückfrage:
If Cells(i, 88).Value = Evaluate(Cells(i, 2).Text & Right(Sheets("Tab1").Cells(2, 5).Text, 2)) Then

Benötigst Du hier tatsächlich eine Formelauswertung oder würde der Verkettungsoperator & alleine genügen?

_________________
Gruß Gerd
Phelan XLPH
Fortgeschritten


Verfasst am:
20. Dez 2011, 02:32
Rufname: Phelan

AW: Code vereinfachen - AW: Code vereinfachen

Nach oben
       Version: Office 2003

Code:
Sub Makro()
Dim i As Long
Dim x As Long
Dim y As Long

Dim arTab1 As Variant
Dim arWerte As Variant

Dim rngTab1 As Range
Dim rngWerte As Range


With Worksheets("Tab1")
    Set rngTab1 = .Range("A3:E" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With

With Worksheets("Werte")
    Set rngWerte = .Range("A3:EG" & .Cells(.Rows.Count, 33).End(xlUp).Row)
End With

arTab1 = rngTab1
arWerte = rngWerte

y = 3

For x = 3 To UBound(arTab1)
   
    For i = 3 To UBound(arWerte)
        If arWerte(i, 34) Like "*" & arTab1(x, 1) Then
        If arWerte(i, 39) = arTab1(x, 2) Then
        If arWerte(i, 79) = arTab1(x, 3) Then
       
        Select Case True
            Case arTab1(x, 4) = "Welt"
                If arWerte(i, 123) = "" Then
                    Select Case True
                        Case arTab1(2, y) Like "Markt*"
                            If arWerte(i, 91) = "Markt" Then
                            If arWerte(i, 65) = "Groesse" Then
                            If arWerte(i, 88) = arWerte(i, 2) & Right(arTab1(2, 5), 2) Then
                                arTab1(x, y) = arWerte(i, 137)
                            End If
                            End If
                            End If
                        Case arTab1(2, y) Like "Grund*"
                            If arWerte(i, 65) = "Grund" Then
                            If arWerte(i, 64) <> "Daten" Then
                            If arWerte(i, 88) = arWerte(i, 2) & Right(arTab1(2, 5), 2) Then
                                arTab1(x, y) = arWerte(i, 137)
                            End If
                            End If
                            End If
                        Case arTab1(2, y) Like "Verkauf*"
                            If arWerte(i, 65) = "Verkauf" Then
                            If arWerte(i, 88) = arWerte(i, 2) & Right(arTab1(2, 5), 2) Then
                                arTab1(x, y) = arWerte(i, 137)
                            End If
                            End If
                    End Select
                End If
           
            Case arTab1(x, 4) = arWerte(i, 123)
                Select Case True
                    Case arTab1(2, y) Like "Markt*"
                        If arWerte(i, 91) = "Markt" Or _
                           arWerte(i, 65) = "Markt" Then
                            If arWerte(i, 88) = arWerte(i, 2) & Right(arTab1(2, 5), 2) Then
                                arTab1(x, y) = arWerte(i, 137)
                            End If
                        End If
                    Case arTab1(2, y) Like "Verkauf*"
                        If arWerte(i, 65) = "Verkauf" Then
                        If arWerte(i, 88) = arWerte(i, 2) & Right(arTab1(2, 5), 2) Then
                            arTab1(x, y) = arWerte(i, 137)
                        End If
                        End If
                End Select
        End Select
       
        End If
        End If
        End If
    Next

Next

rngTab1 = arTab1

End Sub

_________________
Was vorstellbar ist, ist auch machbar. - Albert Einstein
krokojo
Im Profil kannst Du frei den Rang ändern


Verfasst am:
21. Dez 2011, 17:10
Rufname:

Re: AW: Code vereinfachen - Re: AW: Code vereinfachen

Nach oben
       Version: Office 2003

Danke
aber ich bekomm wenn ich es starte immer ein Objektfehler bei den IF-Anweisungen. Scheinbar kann da Programm die Werte in den Variants nicht wie in Cells vergleichen.


Phelan XLPH - 20. Dez 2011, 01:32 hat folgendes geschrieben:
Code:
Sub Makro()
Dim i As Long
Dim x As Long
Dim y As Long

Dim arTab1 As Variant
Dim arWerte As Variant

Dim rngTab1 As Range
Dim rngWerte As Range


With Worksheets("Tab1")
    Set rngTab1 = .Range("A3:E" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With

With Worksheets("Werte")
    Set rngWerte = .Range("A3:EG" & .Cells(.Rows.Count, 33).End(xlUp).Row)
End With

arTab1 = rngTab1
arWerte = rngWerte

y = 3

For x = 3 To UBound(arTab1)
   
    For i = 3 To UBound(arWerte)
        If arWerte(i, 34) Like "*" & arTab1(x, 1) Then
        If arWerte(i, 39) = arTab1(x, 2) Then
        If arWerte(i, 79) = arTab1(x, 3) Then
       
        Select Case True
            Case arTab1(x, 4) = "Welt"
                If arWerte(i, 123) = "" Then
                    Select Case True
                        Case arTab1(2, y) Like "Markt*"
                            If arWerte(i, 91) = "Markt" Then
                            If arWerte(i, 65) = "Groesse" Then
                            If arWerte(i, 88) = arWerte(i, 2) & Right(arTab1(2, 5), 2) Then
                                arTab1(x, y) = arWerte(i, 137)
                            End If
                            End If
                            End If
                        Case arTab1(2, y) Like "Grund*"
                            If arWerte(i, 65) = "Grund" Then
                            If arWerte(i, 64) <> "Daten" Then
                            If arWerte(i, 88) = arWerte(i, 2) & Right(arTab1(2, 5), 2) Then
                                arTab1(x, y) = arWerte(i, 137)
                            End If
                            End If
                            End If
                        Case arTab1(2, y) Like "Verkauf*"
                            If arWerte(i, 65) = "Verkauf" Then
                            If arWerte(i, 88) = arWerte(i, 2) & Right(arTab1(2, 5), 2) Then
                                arTab1(x, y) = arWerte(i, 137)
                            End If
                            End If
                    End Select
                End If
           
            Case arTab1(x, 4) = arWerte(i, 123)
                Select Case True
                    Case arTab1(2, y) Like "Markt*"
                        If arWerte(i, 91) = "Markt" Or _
                           arWerte(i, 65) = "Markt" Then
                            If arWerte(i, 88) = arWerte(i, 2) & Right(arTab1(2, 5), 2) Then
                                arTab1(x, y) = arWerte(i, 137)
                            End If
                        End If
                    Case arTab1(2, y) Like "Verkauf*"
                        If arWerte(i, 65) = "Verkauf" Then
                        If arWerte(i, 88) = arWerte(i, 2) & Right(arTab1(2, 5), 2) Then
                            arTab1(x, y) = arWerte(i, 137)
                        End If
                        End If
                End Select
        End Select
       
        End If
        End If
        End If
    Next

Next

rngTab1 = arTab1

End Sub
Phelan XLPH
Fortgeschritten


Verfasst am:
21. Dez 2011, 18:06
Rufname: Phelan

AW: Code vereinfachen - AW: Code vereinfachen

Nach oben
       Version: Office 2003

In welcher zeile taucht der Fehler auf?
_________________
Was vorstellbar ist, ist auch machbar. - Albert Einstein
krokojo
Im Profil kannst Du frei den Rang ändern


Verfasst am:
21. Dez 2011, 18:13
Rufname:


Re: AW: Code vereinfachen - Re: AW: Code vereinfachen

Nach oben
       Version: Office 2003

Gleich bei der ersten IF-Anweisung

Phelan XLPH - 21. Dez 2011, 17:06 hat folgendes geschrieben:
In welcher zeile taucht der Fehler auf?
Neues Thema eröffnen   Neue Antwort erstellen Alle Zeiten sind
GMT + 1 Stunde

Diese Seite Freunden empfehlen

Seite 1 von 1
Gehe zu:  
Du kannst Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum nicht posten
Du kannst Dateien in diesem Forum herunterladen

Verwandte Themen
Forum / Themen   Antworten   Autor   Aufrufe   Letzter Beitrag 
Keine neuen Beiträge Excel Formeln: Riesen Formel vereinfachen 28 Oli84 702 20. Sep 2011, 14:15
Gast Riesen Formel vereinfachen
Keine neuen Beiträge Excel Formeln: sehr große formel vereinfachen 4 Helga N 202 25. Jun 2011, 23:34
Helga N sehr große formel vereinfachen
Keine neuen Beiträge Excel Formeln: Auswahl aus Großer Tabelle vereinfachen 4 moe_r 173 04. Mai 2011, 11:24
helikopf Auswahl aus Großer Tabelle vereinfachen
Keine neuen Beiträge Excel Formeln: Summenprodukt vereinfachen Hilfe 8 Knorrfix 173 26. Apr 2011, 15:35
Gast Summenprodukt vereinfachen Hilfe
Keine neuen Beiträge Excel Formeln: Formel zum zusammenfassen von Tabellenblättern vereinfachen 3 Spechie 189 09. März 2011, 10:46
Spechie Formel zum zusammenfassen von Tabellenblättern vereinfachen
Dieses Thema ist gesperrt, du kannst keine Beiträge editieren oder beantworten. Excel Formeln: Farbumschlag über Code (ALT+11) formatieren 2 Viper85 896 24. Sep 2010, 08:33
Thomas Ramel Farbumschlag über Code (ALT+11) formatieren
Keine neuen Beiträge Excel Formeln: Summewenn vereinfachen 11 Prüfstelle 396 03. Aug 2010, 10:44
Prüfstelle Summewenn vereinfachen
Keine neuen Beiträge Excel Formeln: Formel vereinfachen 3 Nille81 195 09. Dez 2009, 17:33
Nille81 Formel vereinfachen
Keine neuen Beiträge Excel Formeln: zählenwenn vereinfachen ??? 4 neuling031280 182 27. Nov 2009, 17:12
neuling031280 zählenwenn vereinfachen ???
Keine neuen Beiträge Excel Formeln: Werktage - VBA Code interpretieren 9 m.f 729 08. Okt 2009, 11:10
m.f Werktage - VBA Code interpretieren
Keine neuen Beiträge Excel Formeln: Formel vereinfachen oder Makro? 4 ARTischocke 298 17. Jul 2009, 23:58
shift-del Formel vereinfachen oder Makro?
Keine neuen Beiträge Excel Formeln: Formel vereinfachen 1 Sylvaroth 176 13. Apr 2009, 02:31
Luc:-? Formel vereinfachen
 

----> Diese Seite Freunden empfehlen <------ Impressum - Besuchen Sie auch: Excel Tipps