Hilfe Ich Brauche VBA unterstüzung

Dieses Thema Hilfe Ich Brauche VBA unterstüzung im Forum "Microsoft Office Suite" wurde erstellt von Simsmann, 16. März 2006.

Thema: Hilfe Ich Brauche VBA unterstüzung :|Bockmarius@aol.com Hilfe ich habe ein Problem, ich soll für meinem Chef ein Makro schreiben, das aus eine exel...

  1. :|Bockmarius@aol.com
    Hilfe ich habe ein Problem, ich soll für meinem Chef ein Makro schreiben, das aus eine exel tabelle einträge überprüft, soll heisen, es Prüft ob eine zelle doppelt vorhanden ist. wie kann ich das realiesieren, ich habe verschiedene spalte, einmal 4 ein anderes mal 3. nun dürfen in diesen 4 bzw 3 spalten nicht die selben einträge vorkommen. Bitte helft mir ich bin verzweifelt.
     
  2. Es gibt ja viele Zauberrer und Hellseher, doch mit welchem Programm hat dein Chef dich denn belästigt???

    Sollte es sich zufäälig um ACCESS handeln, dann gibt es dort einen Assistenten um eine Abfrage zu generieren, die nach Duplikaten sucht.

    Ansonsten mußt du dich schon etwas genauer ausdrücken wenn die Hilfe willst!

    Gruß
    Kurt Körner

    Uff: ich muß mich entschúldigen, es ist ja eine Excel-Tabelle, da überlass ich lieber den Excel Experten das Feld.
     
  3. Hallo Simsmann,

    ich hab dir eine Makro zusammengestrickt, der das Gewünschte erfüllen sollte. Bei Mehrfachänderung (also Ziehen von Zellen in Spalten- bzw. Zeilenrichtung) gibt er nur eine Meldung aus, da bei dieser Art der Änderung die ursprünglich markierten Zellen nicht eindeutig herauszufinden sind. Wenn der geändete Bereich in diesem Fall gelöscht wird, trift man auch Zellen, die gültig waren.

    Der Makro besteht aus einer Funktion, die über das Worksheet_Change-Ereignis ausgelöst wird. Dabei werden ihm die notwendigen Parameter mitgegeben.

    Folgenden Makro pakst du in ein Modul in der betreffenden Arbeitsmappe.
    Code:
    Option Explicit
    '******************************************************************************
    Function DoppelteEintraegeImRangeSuchen(ws As Worksheet, _
                                            GeaenderteZellen As Range, _
                                            Bereich As Range)
    '*** ws               - Verweis auf das Arbeitsblatt
    '*** GeaenderteZellen - Bereich einer/mehrerer Zelle/n, die geändert wurden
    '*** Bereich          - zu überwachender Bereich
    '***
    '*** Makro dient zum Verhindern doppelter Einträge im überwachten Bereich
    '***
    '*** Leere Zellen werden nicht gepfüft.
    '******************************************************************************
    
      Dim AdresseErsterFundort As String
      Dim b_DoppeltenEintragGefunden As Boolean
      Dim SuchBereich As Range, Zelle As Range, EineZelle As Range
      
     ->Leerer geanderter Bereich ?
      If GeaenderteZellen Is Nothing Then GoTo AUFRAEUMEN
      
     ->liegt die Zellen im überwachten Bereich ?
      If Application.Intersect(GeaenderteZellen, Bereich) Is Nothing Then GoTo AUFRAEUMEN
      
     ->den Bereich auf den benutzten Teil einschränken
      Set SuchBereich = Application.Intersect(ws.UsedRange, Bereich)
      
     ->kein Bereich im benutzten Bereich ?
      If SuchBereich Is Nothing Then GoTo AUFRAEUMEN
      
     ->Zellen nacheinander bearbeiten
      For Each EineZelle In GeaenderteZellen
      
       ->liegt die Zelle im überwachten Bereich ?
        If Application.Intersect(EineZelle, Bereich) Is Nothing Then GoTo AUFRAEUMEN
        
       ->Leere Zelle -> nicht suchen
        If EineZelle.Value <>  Then
        
         ->Suchen Inhalt von GeaenderteZelle
          Set Zelle = SuchBereich.Find(What:=EineZelle.Value, _
                                       LookIn:=xlValues, _
                                       LookAt:=xlWhole)
          If Not Zelle Is Nothing Then
            b_DoppeltenEintragGefunden = False
            If Zelle.Address <> EineZelle.Address Then
              b_DoppeltenEintragGefunden = True
            Else
              Set Zelle = SuchBereich.FindNext(Zelle)
              If Not Zelle Is Nothing Then
                If Zelle.Address <> EineZelle.Address Then
                  b_DoppeltenEintragGefunden = True
                End If
              End If
            End If
            If b_DoppeltenEintragGefunden Then
             ->Ist mehr als eine Zelle in GeanderteZellen ?
              If GeaenderteZellen.Count = 1 Then
                MsgBox _
                  Doppelter Wert in  & EineZelle.Address(False, False) &  ! & vbLf & _
                  EineZelle.Address(False, False) &  wird gelöscht., vbCritical
                Application.EnableEvents = False
                EineZelle.Value = 
                EineZelle.Select
                Application.EnableEvents = True
              Else
                MsgBox _
                  Doppelter Wert in  & EineZelle.Address(False, False) &  ! & vbLf & _
                  Mehrere Werte wurden gleichzeitig geändert. & vbLf & _
                  Bitte korrigieren Sie von Hand., vbCritical
                GoTo AUFRAEUMEN
              End If
            End If
          End If
        End If
      Next
    AUFRAEUMEN:
      Set SuchBereich = Nothing: Set Zelle = Nothing: Set EineZelle = Nothing
    End Function
    In die Code-Seite des ersten zu überwachenden Blattes kopierst du folgenden Code
    (Code-Seite des Blattes ist am einfachsten zu erreichen über:
    mit rechter Maustaste die Blattlasche anklicken und im Kontext-Menü->Code anzeigen' wählen)
    Code:
    Private Sub Worksheet_Change(ByVal Target As Excel.Range)
      
      Call DoppelteEintraegeImRangeSuchen(ActiveSheet, Target, _
                                          ActiveSheet.Range(C:F))
    End Sub
    Hiermit werden die Spalten C bis F überwacht. Das kannst Du dann deinen Gegebenheiten anpassen, z. B. statt C:F  A:C für die Spalten A bis C.

    Für das zweite zu überwachende Blatt verfahre genauso.

    Gruß Matjes :)
     
  4. DAs ist schon cool. Nur sind das für mich im Moment noch wirre zeichen, also es handelt sich um exel. ich Habe hir mal den Makrocode Hochgeladen den der chef gemacht hat. Ich soll diesen nun noch erweitern, Um das oben genannte. wichtig ist hierbei wol das der code von meinem chef so stehen bleibt. ( gerne kann ich euch auch die tabelle Per e mail schicken wenn ihr damit dann mehr anfangen könnt.
    Code:
    Private Sub Workbook_Open()
      For Each ws In Worksheets
        Check (ws.Name)->Checkt alle Arbeitsmappen durch
      Next ws
    End Sub
    
    
    Private Function Check(Name As String) As Integer
    
     ->Feld wo die Fehlermeldung erscheint leeren
      Worksheets(Name).Range(W1:W65536).Value = 
      
     ->Torwart Spalte 12
      For rwIndex = 2 To Worksheets(Name).Range(B & 65536).End(xlUp).Row-> Zeilen
        For colIndex = 12 To 12-> Spalte L
          With Worksheets(Name).Cells(rwIndex, colIndex)
            If .Value <= 32 And .Value >= 1 Then
              .Interior.ColorIndex = 0-> Hintergrund Transparent
            Else
              .Interior.ColorIndex = 3-> Hintergrund Rot
              Worksheets(Name).Range(W & rwIndex).Value = Worksheets(Name).Range(W & rwIndex).Value & Fehler: Wert bei Torwart darf zwischen 1 und 32 sein! 
            End If
          End With
        Next colIndex
      Next rwIndex
      
     ->Abwehr Spalte 13,14,15
      For rwIndex = 2 To Worksheets(Name).Range(B & 65536).End(xlUp).Row-> Zeilen
        For colIndex = 13 To 15-> Spalte
          With Worksheets(Name).Cells(rwIndex, colIndex)
            If .Value <= 64 And .Value >= 33 Then
              .Interior.ColorIndex = 0
            Else
              .Interior.ColorIndex = 3
              Worksheets(Name).Range(W & rwIndex).Value = Worksheets(Name).Range(W & rwIndex).Value & Fehler: Wert bei Abwehr darf zwischen 33 und 64 sein! 
            End If
          End With
        Next colIndex
      Next rwIndex
      
     -> Mittelfeld Spalte 16,17,18,19
      
      For rwIndex = 2 To Worksheets(Name).Range(B & 65536).End(xlUp).Row-> Zeilen
        For colIndex = 16 To 19-> Spalte
          With Worksheets(Name).Cells(rwIndex, colIndex)
            If .Value <= 96 And .Value >= 65 Then
              .Interior.ColorIndex = 0
            Else
              .Interior.ColorIndex = 3
              Worksheets(Name).Range(W & rwIndex).Value = Worksheets(Name).Range(W & rwIndex).Value & Fehler: Wert bei Mittelfeld darf zwischen 65 und 96 sein! 
            End If
          End With
        Next colIndex
      Next rwIndex
     -> Stürmer Spalte 20,21,22
      For rwIndex = 2 To Worksheets(Name).Range(B & 65536).End(xlUp).Row-> Zeilen
        For colIndex = 20 To 22-> Spalte
          With Worksheets(Name).Cells(rwIndex, colIndex)
            If .Value <= 128 And .Value >= 97 Then
              .Interior.ColorIndex = 0
            Else
              .Interior.ColorIndex = 3
              Worksheets(Name).Range(W & rwIndex).Value = Worksheets(Name).Range(W & rwIndex).Value & Fehler: Wert bei Stürmer darf zwischen 97 und 128 sein! 
            End If
          End With
        Next colIndex
      Next rwIndex
     ->Prüfen ob die Werte mehrmals vorkommen
      
      
      
      
     
    End Function
    für euro hilfe wäre ich dankbar.
     
  5. Ach ja eine kurz frage zu deinem Script. was heist Option explicit
     
  6. Das alle Variablen definiert werden müssen. Das vermeidet Fehler, die schwer zu finden sind.

    Weiteres in der VBA-Hilfe unter->Option'

    Gruß Matjes :)
     
  7. Hallo Simsmann,

    der Makro von deinem Chef liegt in der Code-Seite der Arbeitsmappe (DieseArbeitsmappe), wenn ich das richtig sehe. Der kann auch so bleiben. Eine Veränderung ist nicht notwendig.

    Die Überwachung kannst Du unabhängig davon einbauen.

    Gruß Matjes :)
     
Die Seite wird geladen...

Hilfe Ich Brauche VBA unterstüzung - Ähnliche Themen

Forum Datum
windows 10 on board...brauche hilfe Windows 10 Forum 1. März 2016
Bluescreen brauche bitte hilfe Windows 7 Forum 24. Nov. 2014
Windows 7 Neuinstallation Treiberproblem Dell brauche Hilfe Treiber & BIOS / UEFI 26. Okt. 2014
Brauche mal Hilfe Bitte. Windows 8 Forum 9. Juni 2014
Brauche Hilfe Windows 7 Forum 9. Juni 2013