Microsoft Excel

Herbers Excel/VBA-Archiv

Makro kleiner machen



Excel-Version: 8.0 (Office 97)

Betrifft: Makro kleiner machen
von: HeinoB
Geschrieben am: 08.06.2002 - 02:45:12

Hallo
Ich habe ein Makro geschrieben, das für einen Profi sehr viel kürzer zu schreiben sein dürfte.
Ich behersche dieses leider nicht.
Mein Makro funzt tadellos, aber wie programmiert man das richtig?? Für Tip´s und Hilfe wäre ich Dankbar.
Hier mein Makrobeschreibung:
Wenn in der Tabelle "Eingabe" in Zelle C5 ein Wert über Gültigkeitsauswahl eingetragen wird, dann soll in der selben Tabelle in Zelle C10 ein Wert eingetragen werden, der in der Tabelle "Gültigkeiten" in der Zelle rechts neben der Ausgewählten liegt.(Werte in Gültigkeiten auswahl = C3:C74, und die Werte für C10 sind in D3:D74)
Hier Mein Makro:
'Das Makro wird bei verlassen der Zelle C5 automatisch gestartet.

Sub Kostenstellen()
Sheets("Eingabe").Select
Select Case Range("C5")
Case Is = ""
Range("c10") = ""
Case Is = Sheets("Gültigkeiten").Range("c3")
Range("c10") = Sheets("Gültigkeiten").Range("d3")
Case Is = Sheets("Gültigkeiten").Range("c4")
Range("c10") = Sheets("Gültigkeiten").Range("d4")
Case Is = Sheets("Gültigkeiten").Range("c5")
Range("c10") = Sheets("Gültigkeiten").Range("d5")
Case Is = Sheets("Gültigkeiten").Range("c6")
Range("c10") = Sheets("Gültigkeiten").Range("d6")
Case Is = Sheets("Gültigkeiten").Range("c7")
Range("c10") = Sheets("Gültigkeiten").Range("d7")
Case Is = Sheets("Gültigkeiten").Range("c8")
Range("c10") = Sheets("Gültigkeiten").Range("d8")
Case Is = Sheets("Gültigkeiten").Range("c9")
Range("c10") = Sheets("Gültigkeiten").Range("d9")
Case Is = Sheets("Gültigkeiten").Range("c10")
Range("c10") = Sheets("Gültigkeiten").Range("d10")
Case Is = Sheets("Gültigkeiten").Range("c12")
Range("c10") = Sheets("Gültigkeiten").Range("d12")
Case Is = Sheets("Gültigkeiten").Range("c13")
Range("c10") = Sheets("Gültigkeiten").Range("d13")
Case Is = Sheets("Gültigkeiten").Range("c14")
Range("c10") = Sheets("Gültigkeiten").Range("d14")
Case Is = Sheets("Gültigkeiten").Range("c15")
Range("c10") = Sheets("Gültigkeiten").Range("d15")
Case Is = Sheets("Gültigkeiten").Range("c16")
Range("c10") = Sheets("Gültigkeiten").Range("d16")
Case Is = Sheets("Gültigkeiten").Range("c17")
Range("c10") = Sheets("Gültigkeiten").Range("d17")
Case Is = Sheets("Gültigkeiten").Range("c18")
Range("c10") = Sheets("Gültigkeiten").Range("d18")
Case Is = Sheets("Gültigkeiten").Range("c19")
Range("c10") = Sheets("Gültigkeiten").Range("d19")
Case Is = Sheets("Gültigkeiten").Range("c20")
Range("c10") = Sheets("Gültigkeiten").Range("d20")
Case Is = Sheets("Gültigkeiten").Range("c21")
Range("c10") = Sheets("Gültigkeiten").Range("d21")
Case Is = Sheets("Gültigkeiten").Range("c22")
Range("c10") = Sheets("Gültigkeiten").Range("d22")
Case Is = Sheets("Gültigkeiten").Range("c23")
Range("c10") = Sheets("Gültigkeiten").Range("d23")
Case Is = Sheets("Gültigkeiten").Range("c24")
Range("c10") = Sheets("Gültigkeiten").Range("d24")
Case Is = Sheets("Gültigkeiten").Range("c25")
Range("c10") = Sheets("Gültigkeiten").Range("d25")
Case Is = Sheets("Gültigkeiten").Range("c26")
Range("c10") = Sheets("Gültigkeiten").Range("d26")
Case Is = Sheets("Gültigkeiten").Range("c27")
Range("c10") = Sheets("Gültigkeiten").Range("d27")
Case Is = Sheets("Gültigkeiten").Range("c28")
Range("c10") = Sheets("Gültigkeiten").Range("d28")
Case Is = Sheets("Gültigkeiten").Range("c29")
Range("c10") = Sheets("Gültigkeiten").Range("d29")
Case Is = Sheets("Gültigkeiten").Range("c30")
Range("c10") = Sheets("Gültigkeiten").Range("d30")
Case Is = Sheets("Gültigkeiten").Range("c31")
Range("c10") = Sheets("Gültigkeiten").Range("d31")
Case Is = Sheets("Gültigkeiten").Range("c32")
Range("c10") = Sheets("Gültigkeiten").Range("d32")
Case Is = Sheets("Gültigkeiten").Range("c33")
Range("c10") = Sheets("Gültigkeiten").Range("d33")
Case Is = Sheets("Gültigkeiten").Range("c34")
Range("c10") = Sheets("Gültigkeiten").Range("d34")
Case Is = Sheets("Gültigkeiten").Range("c35")
Range("c10") = Sheets("Gültigkeiten").Range("d35")
Case Is = Sheets("Gültigkeiten").Range("c36")
Range("c10") = Sheets("Gültigkeiten").Range("d36")
Case Is = Sheets("Gültigkeiten").Range("c37")
Range("c10") = Sheets("Gültigkeiten").Range("d37")
Case Is = Sheets("Gültigkeiten").Range("c38")
Range("c10") = Sheets("Gültigkeiten").Range("d38")
Case Is = Sheets("Gültigkeiten").Range("c39")
Range("c10") = Sheets("Gültigkeiten").Range("d39")
Case Is = Sheets("Gültigkeiten").Range("c40")
Range("c10") = Sheets("Gültigkeiten").Range("d40")
Case Is = Sheets("Gültigkeiten").Range("c41")
Range("c10") = Sheets("Gültigkeiten").Range("d41")
Case Is = Sheets("Gültigkeiten").Range("c42")
Range("c10") = Sheets("Gültigkeiten").Range("d42")
Case Is = Sheets("Gültigkeiten").Range("c43")
Range("c10") = Sheets("Gültigkeiten").Range("d43")
Case Is = Sheets("Gültigkeiten").Range("c44")
Range("c10") = Sheets("Gültigkeiten").Range("d44")
Case Is = Sheets("Gültigkeiten").Range("c45")
Range("c10") = Sheets("Gültigkeiten").Range("d45")
Case Is = Sheets("Gültigkeiten").Range("c46")
Range("c10") = Sheets("Gültigkeiten").Range("d46")
Case Is = Sheets("Gültigkeiten").Range("c47")
Range("c10") = Sheets("Gültigkeiten").Range("d47")
Case Is = Sheets("Gültigkeiten").Range("c48")
Range("c10") = Sheets("Gültigkeiten").Range("d48")
Case Is = Sheets("Gültigkeiten").Range("c49")
Range("c10") = Sheets("Gültigkeiten").Range("d49")
Case Is = Sheets("Gültigkeiten").Range("c50")
Range("c10") = Sheets("Gültigkeiten").Range("d50")
Case Is = Sheets("Gültigkeiten").Range("c51")
Range("c10") = Sheets("Gültigkeiten").Range("d51")
Case Is = Sheets("Gültigkeiten").Range("c52")
Range("c10") = Sheets("Gültigkeiten").Range("d52")
Case Is = Sheets("Gültigkeiten").Range("c53")
Range("c10") = Sheets("Gültigkeiten").Range("d53")
Case Is = Sheets("Gültigkeiten").Range("c54")
Range("c10") = Sheets("Gültigkeiten").Range("d54")
Case Is = Sheets("Gültigkeiten").Range("c55")
Range("c10") = Sheets("Gültigkeiten").Range("d55")
Case Is = Sheets("Gültigkeiten").Range("c56")
Range("c10") = Sheets("Gültigkeiten").Range("d56")
Case Is = Sheets("Gültigkeiten").Range("c57")
Range("c10") = Sheets("Gültigkeiten").Range("d57")
Case Is = Sheets("Gültigkeiten").Range("c58")
Range("c10") = Sheets("Gültigkeiten").Range("d58")
Case Is = Sheets("Gültigkeiten").Range("c59")
Range("c10") = Sheets("Gültigkeiten").Range("d59")
Case Is = Sheets("Gültigkeiten").Range("c60")
Range("c10") = Sheets("Gültigkeiten").Range("d60")
Case Is = Sheets("Gültigkeiten").Range("c61")
Range("c10") = Sheets("Gültigkeiten").Range("d61")
Case Is = Sheets("Gültigkeiten").Range("c62")
Range("c10") = Sheets("Gültigkeiten").Range("d62")
Case Is = Sheets("Gültigkeiten").Range("c63")
Range("c10") = Sheets("Gültigkeiten").Range("d63")
Case Is = Sheets("Gültigkeiten").Range("c64")
Range("c10") = Sheets("Gültigkeiten").Range("d64")
Case Is = Sheets("Gültigkeiten").Range("c65")
Range("c10") = Sheets("Gültigkeiten").Range("d65")
Case Is = Sheets("Gültigkeiten").Range("c67")
Range("c10") = Sheets("Gültigkeiten").Range("d67")
Case Is = Sheets("Gültigkeiten").Range("c68")
Range("c10") = Sheets("Gültigkeiten").Range("d68")
Case Is = Sheets("Gültigkeiten").Range("c69")
Range("c10") = Sheets("Gültigkeiten").Range("d69")
Case Is = Sheets("Gültigkeiten").Range("c70")
Range("c10") = Sheets("Gültigkeiten").Range("d70")
Case Is = Sheets("Gültigkeiten").Range("c71")
Range("c10") = Sheets("Gültigkeiten").Range("d71")
Case Is = Sheets("Gültigkeiten").Range("c72")
Range("c10") = Sheets("Gültigkeiten").Range("d72")
Case Is = Sheets("Gültigkeiten").Range("c73")
Range("c10") = Sheets("Gültigkeiten").Range("d73")
Case Is = Sheets("Gültigkeiten").Range("c74")
Range("c10") = Sheets("Gültigkeiten").Range("d74")
Case Is = Sheets("Gültigkeiten").Range("c66")
Range("c10") = Sheets("Gültigkeiten").Range("d66")
Case Is = Sheets("Gültigkeiten").Range("c11")
Range("c10") = Sheets("Gültigkeiten").Range("11")
End Select
End Sub

  

Re: Makro kleiner machen
von: Hans W. Herber
Geschrieben am: 08.06.2002 - 03:21:24

Hallo Heino,

da läßt sich leider nicht allzuviel machen:


Sub Kostenstellen()
   Dim wks As Worksheet
   Dim var As Variant
   Dim iRow As Integer
   Set wks = Worksheets("Gültigkeiten")
   With Worksheets("Eingabe")
      If .Range("C5").Value = "" Then
         .Range("C10").Value = ""
      Else
         var = Application.Match(.Range("C5").Value, _
            wks.Range(wks.Cells(3, 3), wks.Cells(74, 3)), 0)
         If Not IsError(var) Then
            .Range("C10").Value = wks.Cells(var, 3).Value
         End If
      End If
   End With
End Sub

hans

  

Re: Makro kleiner machen
von: HeinoB
Geschrieben am: 08.06.2002 - 03:57:38

Hallo Hans
Erst einmal herzlichen Dank für Deine Hilfe.
Dein Makro ist ja nun wirklich ein wenig kürzer.
Leider holt sich das Makro nicht die Daten die ich brauche.
Es werden jetzt die Daten zwei Zellen oberhalb der Suchstelle in C10 geschrieben, ich brauche aber die Daten rechts der Fundstelle.
Die Suchspalte ist richtig.Nur der Wert der in die "Eingabe" Tabelle übertragen werden soll ist falsch.
Kannst Du mir da eventuell nochmals weiterhelfen.
Gruß Heino

  

Re: Makro kleiner machen
von: HeinoB
Geschrieben am: 08.06.2002 - 03:58:46

Hallo Hans
Erst einmal herzlichen Dank für Deine Hilfe.
Dein Makro ist ja nun wirklich ein wenig kürzer.
Leider holt sich das Makro nicht die Daten die ich brauche.
Es werden jetzt die Daten zwei Zellen oberhalb der Suchstelle in C10 geschrieben, ich brauche aber die Daten rechts der Fundstelle.
Die Suchspalte ist richtig.Nur der Wert der in die "Eingabe" Tabelle übertragen werden soll ist falsch.
Kannst Du mir da eventuell nochmals weiterhelfen.
Gruß Heino

  

Re: Makro kleiner machen
von: Hans W. Herber
Geschrieben am: 08.06.2002 - 04:04:30

... sorry, die Spaltenverschiebung war mir nicht aufgefallen. Da der Code aber ziemlich logisch aufgebaut ist, einfach nur statt:
.Range("C10").Value = wks.Cells(var, 3).Value

jetzt:
.Range("C10").Value = wks.Cells(var, 4).Value

Ich empfehle Dir, die xlBasics von meiner Downloadseite runterzuladen.

hans

  

Re: Makro kleiner machen
von: HeinoB
Geschrieben am: 08.06.2002 - 05:08:20

Danke Hans
Ich habe mir Deine CD gekauft und bin kräftig am Durchsehen.
Die CD ist sehr hilfreich beim lernen. Aber manchmal denkt man halt zu kompliziert.Oder will das ergebnis schneller haben als man kann.
Erst einmal herzlichen Dank.
Ich habe gleich Feierabend.
Schönes Wochenende
Heino

  

Nachtrag
von: HeinoB
Geschrieben am: 08.06.2002 - 05:17:39

Noch eine kleine Änderung damit es passt

vorher:
wks.Range(wks.Cells(3, 3), wks.Cells(74, 3)), 0)
jetzt:
wks.Range(wks.Cells(1, 3), wks.Cells(74, 3)), 0)
Super Hans
Ich habe wiedert einmal etwas gelernt.
Gruß Heino

 

Beiträge aus den Excel-Beispielen zum Thema "Makro kleiner machen"