---

Hi
Dies ist mein erster Beitrag hier im Excel-Forum.
Bitte um Nachsicht. 

Ich habe zwar kein grosses Problem, aber man kann es sicher besser lösen als ich es getan habe. Vor allem nicht soviel Einzel Sub's.
Ich habe ein wenig herumprobiert, aber etwas brauchbares ist nicht herausgekommen.

Der beiliegende Code:
Der ist nicht ausgekürzt - auch weil er so übersichtlich für mich ist. Aber genau da frage ich mich, wie er sinnvoll gekürzt werden könnte. Ich stelle mir vor, dass nur eine Schleife gemacht werden kann. Ich habe ca. 40 Auswertungen zu machen. Denkbar sind aber weitaus mehr. Und dann wird es eben schon ein wenig aufwendig.
Aber seht selber mal.
Experten werden erkennen, um was es geht. Ansonsten gebe ich gerne Auskunft.
Den Dialog-Code habe ich nicht dabei.
Der ist eh auf dem alten Excel aufgebaut, bin es aber gewohnt so, und es passt für mich.
Ich will ja dann im Prinzip auswerten, was mir der Dialog zurückgibt.
Bei mir eine ZAHL 1-40 (oder mehr) in einer bestimmten Zelle.
aufgrund diesem mache ich Unter Sup.
Im Moment noch seeeer rudimentär natürlich.
(OK lachen darf man kurz darüber, aber nachher Verbesserung anbringen, Bitte.
Ich danke schon mal herzlich für euere Ideen.

fredy

Sub auswerten_1()
Range("A1").Select
If Selection = "1" Then
    wenn_1
End If
If Selection = "2" Then
    wenn_2
End If
If Selection = "3" Then
    wenn_3
End If
ende sub

sind hier natürlich nur 3 aufgegführt !
---------------------------
dann folgen die eigentlichen Auswerte Sub's
------------------------

Sub wenn_1()
    Sheets("Tabelle1").Select
                    Range("A2:M2").Select
    Selection.Copy
    Sheets("UW").Select
    Range("R1").Select
    ActiveSheet.Paste
    Range("A1").Select
End Sub
Sub wenn_2()
    Sheets("Tabelle1").Select
                    Range("A3:M3").Select
    Selection.Copy
    Sheets("UW").Select
    Range("R1").Select
    ActiveSheet.Paste
    Range("A1").Select
End Sub
Sub wenn_3()
    Sheets("Tabelle1").Select
                  Range("A4:M4").Select
    Selection.Copy
    Sheets("UW").Select
    Range("R1").Select
    ActiveSheet.Paste
    Range("A1").Select
End Sub

------------------
Gib niemals auf !!!   P8 1.9.SP1
Suchen

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo korgli,

zunächst mal Herzlich Willkommen beim Excel-Brett!

Zu lachen gibts hier wenig, da Du Dich selbst bemühst, zur Lösung zu kommen (statt Code aus dem Netz zu klauen und zu verwursteln - wie dies manch andere tun).

Mir fallen spontan ein paar Dinge auf. Du schreibst von 40 (oder mehr) Auswertungen. Das schreit förmlich nach Select Case anstelle von if.

Code:

---

Sub auswerten_1()
Dim sel

  sel = Range("A1")
  Select Case sel
    Case 1
      wenn_1
    Case 2
      '...
  Case Else: MsgBox "Was soll ich damit anfangen?"
  End Select
 
End Sub

---

Nur mal, um das Prinzip darzustellen. Setz den Cursor hinter Select Case und drücke F1, dann gibts mehr Hilfe.

Deine Sub wenn_1()s unterscheiden sich auf den ersten Blick nur durch den Bereich, der kopiert werden soll --> Range("A2:M2")? Ändere den Namen in wenn_x(str_Bereich as String) - und str_Bereich wird oben in der (erweiterten) Select-Anweisung bestückt:

Code:

---

'...
  Case 1
  wenn_x "A2:M2"'immer die gleiche Sub mit unterschiedlichen Parametern aufrufen
  Case 2
  wenn_x "A3:M3"
'...

---

Damit wird das ganze kürzer und übersichtlicher - alles ungetestet. War das nun schon die Antwort auf Deine Frage?

[Edit: Zu "Select" gibts bei Online-Excel.de einen guten Beitrag /Edit]
------------------
DIN1055.de  |  Lastannahmen für Anwender NEU: Foren zu DIN 1055

[Diese Nachricht wurde von Paulchen am 21. Dez. 2009 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Paulchen

Nix zu lachen - wird sich um mich ändern. 
Vielen Dank - jep das ist sicher mal ein Anfang.
Ich probiere immer auch selber aufzubauen.
Darum erst mal dieser sehr einfache Aufbau.

Ich habe vor etlichen Jahren mal Excel strapaziert (oder umgekehrt)
Dann lang nicht mehr, weil andere Aufgaben.
Und jetzt sehe ich, dass sich viel geändert hat.
Damit muss ich mich mal befassen. Wobei es eher eine Spielerei für mich ist. Man gönnt sich ja sonst nix. 

Eine Kürzung habe ich mal gemacht, dass ich nicht 2 Subs brauche.
Aber Dein Ansatz ist ja um Längen besser.
Hier mal meine 2. Kreation (in Grün) 
DANKE
fredy

Range("A1").Select
If Selection = "1" Then
    Sheets("Tabelle1").Select
    Range("A2:M2").Select
    Selection.Copy
    Sheets("UW").Select
    Range("R1").Select
    ActiveSheet.Paste
    Range("A1").Select
    End If

------------------
Gib niemals auf !!!   P8 1.9.SP1
Suchen

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi Fredy,

ich weiss ich weiss ... du wolltest erstmal deine Schreibweise beibehalten,
deswegen nur am Rande:

Code:

---

Sub y()
If Sheets("UW").Range("A1") = 1 Then _
Sheets("Tabelle1").Range("A2:M2").Copy Sheets("UW").Range("R1")
Application.CutCopyMode = False
End Sub

---

Aber egal wie, das Application.CutCopyMode = False solltest du
mit reintun, damit der Kopiermodus beendet (demarkiert) wird.

lg Nancy

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Salü Nancy 

Vielen Dank.
Du hast ganz recht beobachtet.
Deine Kürzung ist aber das, was ich suche.
Weil ich nicht recht weiss, was ich weglassen darf usw. 

Mir schwebt noch was vor, dass ich, nicht sagen muss, dass
wenn z.b:
eine  1 steht Excel dann Zelle A2:M2 kopieren soll.
oder 2    dann A3:M3
also das umgehen von einzelnen diesen Anweisungen.
Denn in A1 steht z.b. eine 1.
dann müsste ich doch Excel beibringen können, dass dann
in Bezug zu "A1" - da steht z.b. "5"
sich der Wert der Anweisung bei A*:M* z.b. um 1 erhöht. Also A6:M6 .
Ich möchte also die gleichen Anweisungen ersparen, jeweils basierend auf "A1" - Alternativ wäre natürlich auch möglich die gleiche Zahl wie "A1" zu nehmen.

Oder sowas in der Art.

Aber ich denke das geht dann nicht ?? 
Wäre halt toll, wenn man das vereinfachen könnte.
Kann ja auch vorkommen, dass nicht 40 sondern 400 Quellen sind. 
Dann wird das aufwändig. OK dann wäre Excel nicht das richtige Programm dafür - ich weiss. Wäre ja dann Datenbank.
Aber ich lass den Gedanken mal nicht zu.

Oder gibt es dafür eine GANZ ANDERE Lösung ?
Ich habe noch nix gefunden.

Herzlichen Dank
fredy

------------------
Gib niemals auf !!!   P8 1.9.SP1
Suchen

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Fredy ganz fix nur, sowas?

Code:

---

Sub y()
    Dim i As Long
    i = Sheets("UW").Range("A1")
    With Sheets("Tabelle1")
        .Range(.Cells(i + 1, 1), .Cells(i + 1, 14)).Copy Sheets("UW").Range("R1")
    End With
    Application.CutCopyMode = False
End Sub

---

lg Nancy

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Jo, bin wieder zu spät. Ähnlich wie Nancys, aber nicht so kompakt.

Code:

---

Sub auswerten_1()
    Dim reihe
    reihe = Range("A1").Value
    Sheets("Tabelle1").Select
    Range(Cells(reihe + 1, 1), Cells(reihe + 1, 13)).Select
    Selection.Copy
    Sheets("UW").Select
    Range("R1").Select
    ActiveSheet.Paste
    Range("A1").Select
End Sub

---

Zitat:

---

Original erstellt von korgli:
... dann wäre Excel nicht das richtige Programm dafür ...

---

Excel kann alles, nur nicht Kaffee kochen 

------------------
Seit Pro/E Version 1 dabei, auwei...

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hab' ich mich doch glatt an den Fingern verzählt 
muss natürlich Cells(i+1,13) heissen.

Alternativ kannstes auch so schreiben, je nachdem ob Dir range oder cells besser gefallen:

Code:

---

With Sheets("Tabelle1")
'.Range(.Cells(i + 1, 1), .Cells(i + 1, 13)).Copy Sheets("UW").Range("R1")
.Range("A" & i + 1 & ":M" & i + 1).Copy Sheets("UW").Range("R1")
End With

---

CU Nancy

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hi

Ihr seid ja der pure Wahnsinn.
vielen Dank für Euere tolle Hilfe. Da habe ich viel gelernt.
Im Nachhinein sieht das sehr logisch aus.
Funzt einwandfrei.
Hoffe es hilft andern auch noch.

Euch Helfern wünsche ich einen supertollen Abend, neeee Woche, neeee Jahr 
Also einen Kaffee kochen könnt ich schon... 

fredy

------------------
Gib niemals auf !!!   P8 1.9.SP1
Suchen

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Nochmal kurz dazu:

> Weil ich nicht recht weiss, was ich weglassen darf usw. 

Keine Berührungsängste, die ganzen Selects sind 'bääähh' teils kontraproduktiv und kannste bedenkenlos,
im wahrsten Sinne des Wortes 'ausselec(k)tieren' 

Wenn du vorhast verstehend in Excel-VBA zu lernen, nutze ruhig den Recordercode,
versuche aber immer gleich hinterher strikt 'auszumisten'.
Also gar nicht erst angewöhnen den Käse;-)

Just for fun, mal zwei Subs die absolut dasselbe machen,
Erstere dauerte am längsten, den Recorderstil nachzuahmen ist fast ne Kunst,
weil es mir so sehr gegen den Strich geht.

Sollte jetzt aber nicht wie das Amen in der Kirche & absolutes Striktum klingen,
Recordercode lesen ist einfacher als schreiben und überhaupt ...

Laufe Gefahr jetzt zu lang wegen so 'nem bissle select zu werden,
in diesem Sinne hör ich jetzt auf, und verteufel nix 

Einfach mal machen, das Lernen & Hinterfragen kommt automatisch dazu,
völlig normale Kiste & auch nicht  darüber sondern  .

Viel Erfolg,
Nancy
--

Code:

---

Option Explicit

Sub x()
    Dim i As Long, t As Double
    t = Timer
    For i = 1 To 500
        Sheets("Tabelle1").Select
        Range("A1").Select
        Selection = "Hello"
        Range("B1").Select
        Selection = "world"
        Range("C1").Select
        Selection = "! ;-)"
        Range("A1:C1").Select
        Selection.Copy
        Sheets("Tabelle2").Select
        Range("A1").Select
        ActiveSheet.Paste
    Next
    MsgBox Timer - t, , "eine selected 'world';-)"
End Sub

Sub y()
    Dim i As Long, t As Double
    For i = 1 To 1000
        Sheets("Tabelle1").Range("A1") = "Hello"
        Sheets("Tabelle1").Range("B1") = "world"
        Sheets("Tabelle1").Range("C1") = "! ;-)"
        Sheets("Tabelle1").Range("A1:C1").Copy Sheets("Tabelle2").Range("A1")
    Next
    MsgBox Timer - t, , "eine einfache(re) 'world' ;-)"
End Sub

---

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Danke

Super Erklärung.
Es war genau meine Meinung, mal zu recorden, und dann zu kürzen.
Ich meinte aber auch, dass es möglich sein muss, es in einem kurzen Makro lösen zu können.
Da meine Hirnkapazität nicht ausreichte, - naja mein Wissen, - wollte ich in diesem Super-Forum mal sehen, was kommt, das mich auf den Weg bringt.

Es hat meine Erwartung meilenweit übertroffen.
So schnell kann ich gar nicht lernen, wie hier Antworten kommen.
Und solche Erklärungen wie du sie oben machst, sind für manche Gold wert, denke ich mal.
Vielen Dank dafür.
Und jetzt wünsche ich allen schöne Festtage.
Ich werd noch ein wenig basteln, und blöde Fragen stellen. 

fredy

------------------
Gib niemals auf !!!   P8 1.9.SP1
Suchen

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP