Vereinfachen

Bild

Betrifft: Vereinfachen von: René
Geschrieben am: 08.03.2005 10:18:57

Hallo zusammen,

kann mir jemand sagen, wie ich das angehängte Modul vereinfachen kann?
Abrufbar unter https://www.herber.de/bbs/user/19344.txt

Besten Dank für Eure Hilfe

Gruss
René

Bild


Betrifft: AW: Vereinfachen von: u_
Geschrieben am: 08.03.2005 11:18:16

Hallo,
nach diesem Schema:
Sub druck_etikettenliste_A()
  Dim wshSta As Worksheet, wshET As Worksheet
  Dim LArt As String
  Dim SZähler As Integer, LZähler As Integer, i As Integer
  
  Set wshET = Sheets("Et")
  Set wshSta = Sheets("Sta")
    '
    wshET.Range("A2:I300").Delete Shift:=xlToLeft
    '
    Select Case LArt
      Case "x9":     ' Aktive
      Case Else:    Exit Sub
    End Select
    '
    SZähler = 2
    For LZähler = 2 To 201
        ' Datensatz holen, nach LArt
      If wshSta.Range("AR" & LZähler).Value = LArt Then
        ' DS übernehmen
        For i = 1 To 6
          wshET.Cells(SZähler, i) = wshSta.Cells(LZähler, i + 1)
        Next i
        SZähler = SZähler + 1
      End If
    Next LZähler
    ' Einträge sortieren
    wshET.Range("A2:F" & SZähler - 1).Sort Key1:=wshET.Range("A3"), Order1:=xlAscending, Key2:=wshET.Range("B3"), _
        Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom
    '
'    Etiketten_form.Show
    '
End Sub

Gruß


Bild


Betrifft: AW: Vereinfachen von: René
Geschrieben am: 08.03.2005 11:28:12

Hallo u

Dieser Schritt ist mir bekannt. Ich habe aber das Problem, dass der "Range für LArt" nicht immer in der gleichen Spalte ist.
LArt"x9" = Range("AR")
LArt"X10" = Range ("AS") etc.
und das bis zur Nummer 20

Muss ich dann wirklich für jeden Teil einen neuen Sub erstellen?

Gruss
René


Bild


Betrifft: AW: Vereinfachen von: u_
Geschrieben am: 08.03.2005 11:56:35

Hallo,
nein, brauchst du nicht. LArt an die Sub übergeben und dort auswerten.
Sub etikettenliste_aktive()
    LArt = "x9"
    Call druck_etikettenliste(LArt)
End Sub


Sub etikettenliste_ehrenmitglied()
    LArt = "x10"
    Call druck_etikettenliste(LArt)
End Sub


Sub druck_etikettenliste(LArt As String)
  Dim wshSta As Worksheet, wshET As Worksheet
  Dim SZähler As Integer, LZähler As Integer, i As Integer, iCol As Integer
  
  Set wshET = Sheets("Et")
  Set wshSta = Sheets("Sta")
  'Zuordnung LArt - Spalte
  Select Case LArt
    Case "x9": iCol = 44  'Spalte AR
    Case "x10": iCol = 45 'Spalte AS
    Case "x11": iCol = 46 'Spalte AT
    Case "x15": iCol = 50 'Spalte AX
    'usw. Die Zuordnung musst du selbst machen.
    Case Else: Exit Sub
  End Select
    '
    wshET.Range("A2:I300").Delete Shift:=xlToLeft
    '
    '
    SZähler = 2
    For LZähler = 2 To 201
        ' Datensatz holen, nach LArt
      If wshSta.Cells(LZähler, iCol).Value = LArt Then
        ' DS übernehmen
        For i = 1 To 6
          wshET.Cells(SZähler, i) = wshSta.Cells(LZähler, i + 1)
        Next i
        SZähler = SZähler + 1
      End If
    Next LZähler
    ' Einträge sortieren
    wshET.Range("A2:F" & SZähler - 1).Sort Key1:=wshET.Range("A3"), Order1:=xlAscending, Key2:=wshET.Range("B3"), _
        Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
        MatchCase:=False, Orientation:=xlTopToBottom
    '
'    Etiketten_form.Show
    '
End Sub

Gruß


Bild


Betrifft: AW: Vereinfachen von: René
Geschrieben am: 08.03.2005 12:07:41

Hallo u

Bei mir stand da wohl irgendetwas auf der Leitung. :-)

Hab das ganze schon eingebaut. Funktioniert super!

Danke vielmals.

Gruss
René


 Bild

Beiträge aus den Excel-Beispielen zum Thema "Vereinfachen"