Excel

Dieses Thema Excel im Forum "Microsoft Office Suite" wurde erstellt von falcon35, 5. Mai 2005.

Thema: Excel Hallo, ich habe ein Excel-Problem. Und zwar: Im Worksheet1 habe ich in der Spalte A Ski-Marken Im Worksheet2 habe...

  1. Hallo,

    ich habe ein Excel-Problem.

    Und zwar:

    Im Worksheet1 habe ich in der Spalte A Ski-Marken
    Im Worksheet2 habe ich Anforderungen
    Jetzt soll per Mausklick pro Automarke ein neues Worksheet angelegt werden mit den Inhalten von Worksheet2

    Vielen Dank im Voraus.

    Grüße
    falcon
     
  2. Hallo falcon35,

    ist ein bischen verwirrend Ski-Marken <-> Automarke.

    Ich gehe mal davon aus, daß pro Marke das Worksheet 2 kopiert  und der Blattname des kopierten Blattes mit der Marke versehen werden soll. Und das für alle Marken in Spalte A von Worksheet1.

    Für ein Makro ist die Zeile der ersten Marke in Spalte A notwendig.
    Weiterhin muß der Name von Worksheet1 und 2 fest sein, also Namesfestlegung notwendig, z.B. Marken und Anforderungen.

    Stellt sich noch die Frage, ob Markennamen Zeichen enthalten, die für einen Blattnamen nicht zulässig sind. Soll da eine Prüfung erfolgen? Sollen die unzulässigen Zeichen einfach weggelassen werden oder durch ein bestimmtes ersetzt werden ? Oder einfach nur eine Meldung, daß die Marke nicht angelegt werden konnte?

    Auch die Namenslänge ist auf 31 Zeichen beschränkt. Was soll passieren, wenn diese überschritten wird ?

    Noch ein Punkt: Bei eventueller Namensgleichheit, wie soll da der Makro reagieren? Meldung ?

    Gruß Matjes :)
     
  3. Hallo Matjes,

    die Marken fangen ab Zeile 70 an und enden bei 120.
    Die Markennamen sind nicht länger als 25 Zeichen. Es sind keine Sonderzeichen enthalten, deshalb ist eine Prüfung meiner meinung nach nicht nötig. Bei Namensgleichheit soll ein fehler generiert werden.

    Grüße
    falcon35
     
  4. Hallo falcon35,

    in den Konstanten des Makros mußt Du ggf. noch die Blattnamen anpassen. Prüfung findet statt. Stößt die Prüfung auf unzulässige Zeichen oder einen zu langen Blattnamen, gibt's eine Meldung.

    Gruß Matjes :)

    Code:
    Sub MarkenNamenBlaetterErzeugen()
    
     ->Quellblatt
      Const c_BltMarken = Marken
      Const c_SPMarke = 1->entspricht Spalte A
      Const c_ZersteWerteZeile = 70
      Const c_ZletzteWerteZeile = 120
     ->zu kopierendes Blatt
      Const c_BltTemplate = Anforderungen
     ->Zielblatt
      Const c_NamenAuf31ZeichenKuerzen As Boolean = False
      Const c_NamenUngueltigeZeichenErsetzen As Boolean = False
      Const c_Erstazzeichen As String = _
    
      Dim wb As Workbook
      Dim wsq As Worksheet, wst As Worksheet, wsz As Worksheet
      Dim s_Blatt As String, l_qZeileMax As Long, x As Long
    
      Set wb = ActiveWorkbook
    
      On Error GoTo ErrorhandlerBlatt:
      s_Blatt = c_BltMarken
      Set wsq = Worksheets(s_Blatt)
      s_Blatt = c_BltTemplate
      Set wst = Worksheets(s_Blatt)
      On Error GoTo 0
      
     ->auskommentiert da feste letzte Zeile c_ZletzteWerteZeile
     ->für variable Anzahl von Marken kann in der folgenden
     -> For-Anweisung c_ZletzteWerteZeile durch l_qZeileMax ersetzt werden
     -> wenn in der Spalte Marken keine weiteren Information nach den
     ->Marken stehen
     ->l_qZeileMax = wsq.Cells(wsq.Rows.Count, c_SPMarke).End(xlUp).Row
      
     ->Über alle Marken
      For x = c_ZersteWerteZeile To c_ZletzteWerteZeile
       ->nächster Markenname
        s_Blatt = Trim(wsq.Cells(x, c_SPMarke).Value)
       ->Blattnamen prüfen
       ->ggf Ersatzzeichen _ und auf 31 Zeichen kürzen
        If BlattnamePruefen(s_Blatt, _
                            c_NamenUngueltigeZeichenErsetzen, _
                            c_Erstazzeichen, _
                            c_NamenAuf31ZeichenKuerzen) Then
         ->Blattname bereits vorhanden pruefen
          If BlattnameExistiertNichtPruefen(wb, s_Blatt) Then
           ->TemplateBlatt ans Ende kopieren
            wst.Activate
            wst.Copy After:=wb.Worksheets(wb.Worksheets.Count)
            Set wsz = ActiveSheet
           ->neues Blatt mit Markennamen versehen
            wsz.Name = s_Blatt
          Else
            MsgBox (Blatt  & s_Blatt &  existiert bereits !)
          End If
        End If
      Next
    Aufraeumen:
      Set wb = Nothing: Set wsq = Nothing: Set wsz = Nothing: Set wst = Nothing
      Exit Sub
    ErrorhandlerBlatt:
      Err.Clear
      MsgBox (Blatt  & s_Blatt &  konnte nicht angesprochen werden.)
      GoTo Aufraeumen
    End Sub
    '****************************************************************
    Private Function BlattnameExistiertNichtPruefen(wb As Workbook, s_Blatt As String) As Boolean
      On Error Resume Next
      wb.Worksheets(s_Blatt).Activate
      If Err.Number = 0 Then
        BlattnameExistiertNichtPruefen = False
      Else
        Err.Clear
        BlattnameExistiertNichtPruefen = True
      End If
      On Error GoTo 0
    End Function
    '****************************************************************
    Private Function BlattnamePruefen(s_BlattName As String, _
                                      b_Ersatz As Boolean, _
                                      s_Ersatzzeichen As String, _
                                      b_Kuerzen As Boolean) As Boolean
    '****************************************************************
    'b_Ersatz:
    '    True - bei unzulässige Zeichen werden durch Erstazzeichen ersetzt
    'b_Kuerzen:
    '    True - wenn der Blattname mehr als 31 Zeichen hat, wird er auf 31 gekürzt
    
      Dim x As Long, s As String, s_OutPut As String
      
      BlattnamePruefen = False
      
     ->prüfen: Blattname leer
      If s_BlattName =  Then Exit Function
      
     ->Zeichen auf zulässigkeit prüfen
      For x = 1 To Len(s_BlattName)
        s = Mid(s_BlattName, x, 1)
        Select Case s
          Case 0 To 9, a To z, A To Z, Ä, ä, Ö, ö, Ü, ü, ß
          Case ,, ., _, -, #,->, +, =, ), (, ], [, }, {
          Case ;, &, %, $, §, !, @, <, >
          Case Else
            If b_Ersatz Then
              s = s_Ersatzzeichen
            Else
              MsgBox (Zeichen  & x &  des Blattnamens-> & s_BlattName &-> unzulässig!)
              Exit Function
            End If
        End Select
        s_OutPut = s_OutPut & s
      Next
      
     ->Ersetzenmodus: korrigierten Blattnamen setzen
      If b_Ersatz Then s_BlattName = s_OutPut
      
     ->prüfen: max. Länge überschritten
      If Len(s_BlattName) > 31 Then
        If b_Kuerzen Then
          s_BlattName = Left(s_BlattName, 31)
        Else
          MsgBox ( _
            Blattname-> & s_BlattName &-> hat mehr als 31 Zeichen -> unzulässig !)
            Exit Function
        End If
      End If
      
      BlattnamePruefen = True
    End Function
     
  5. Hallo Matjes,

    funktioniert echt klasse.

    Vielen Dank!!

    Grüße
    falcon35
     
Die Seite wird geladen...

Excel - Ähnliche Themen

Forum Datum
Excel-Feature gesucht Microsoft Office Suite 11. Okt. 2016
Excel Tabelle Werte zu ordnen Microsoft Office Suite 23. Sep. 2016
Excel: Bereiche auf 'leer' Überprüfen Microsoft Office Suite 15. Sep. 2016
Import Datensatz inkl = und - Zeichen in Excel/Libre CALC Software: Empfehlungen, Gesuche & Problemlösungen 20. Mai 2016
Bestimmter User kann seine Excel Dateien nicht mehr direkt öffnen Software: Empfehlungen, Gesuche & Problemlösungen 16. Apr. 2016