Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1560to1564
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

ActiveCell.Column- Problem

ActiveCell.Column- Problem
04.06.2017 14:12:55
STeve
Hallo an die fleißigen VBA Profi-Helfer.
Bitte um Hilfe.
(Urcode von Max2)
Siehe Datei:
https://www.herber.de/bbs/user/114017.xlsm
Das Zählwerk in den Zellen A:22 bis M:22 funktioniert so weit perfekt.
Die Art der Eintragung (z.B. AAA, LAA, EEE, BBB usw) wird gezählt und die SOLL- Anzahl in der Spalte A wird verglichen.
Die Farben rot (SOLL nicht erreicht), grün (genau SOLL und gelb (SOLL überschritten) werden vergeben.
Wenn in den Eintragungspalten (also oben - C:1 bis M:20)eine Eintragung erfolgt - als mit "Enter" Taste-
oder
eine Eintragung entfernt - also mit "entf" Taste - wird -----klappt es.
Problem:
Wenn aber ein Eintrag mit der Rücktaste entfernt wird und mit Tabulatortaste aus der Zelle gesprungen wird - aktualisiert es sich natürlich nicht.
Der von mir eingefügte Begriff: ActiveCell.Column
in den Subs:
Private Sub count_values(ByVal countMe As String, ByRef amount As Long)
Private Sub change_color()
ist dann immer falsch.
Gibt es da eine Lösung?
Besten Dank, schönes PfingstWE und mfg
STeve

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: ActiveCell.Column- Problem
04.06.2017 14:33:07
Nepumuk
Hallo,
teste mal:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim search As String
    Dim i As Long, j As Long
    
    On Error Resume Next
    Select Case Target.Column
        Case 3 To 13
            
            Application.EnableEvents = False
            
            For i = 22 To Cells(Rows.Count, 2).End(xlUp).Row
                search = Cells(i, 2).Value
                Call count_values(search, j, Target.Column)
                
                Cells(i, Target.Column).Value = j
            Next i
            
            Call change_color(Target.Column)
            
            Application.EnableEvents = True
    End Select
End Sub

Private Sub count_values(ByVal countMe As String, ByRef amount As Long, ByVal lngColumn As Long)
    Dim rng As Range, c
    Dim counter As Long
    Dim ws As Worksheet
    Dim firstAddress
    
    
    On Error Resume Next
    
    Set ws = ThisWorkbook.Sheets("Zaehlwerk")
    With ws
        
        Set rng = .Range(.Cells(.Rows.Count, lngColumn), .Cells(1, lngColumn))
        
        With rng
            Set c = .Find(countMe, LookIn:=xlValues)
            
            If Not c Is Nothing Then
                
                firstAddress = c.Address
                Do
                    counter = counter + 1
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
                
            End If
            
        End With
        
    End With
    
    amount = counter
    
End Sub

Private Sub change_color(ByVal lngColumn As Long)
    Dim ws As Worksheet
    Dim i As Long, j As Long
    Dim soll As Integer, ist As Integer
    
    Set ws = ThisWorkbook.Sheets("Zaehlwerk")
    With ws
        
        i = .Cells(.Rows.Count, 2).End(xlUp).Row
        
        For j = 22 To i
            soll = .Cells(j, 1).Value
            ist = .Cells(j, lngColumn).Value
            
            If ist = soll Then
                .Cells(j, lngColumn).Interior.ColorIndex = 4
                
            ElseIf ist > soll Then
                .Cells(j, lngColumn).Interior.ColorIndex = 6
            Else
                .Cells(j, lngColumn).Interior.ColorIndex = 3
                
            End If
        Next j
    End With
    
End Sub

Gruß
Nepumuk
Anzeige
Nepumuk - Große Klasse
04.06.2017 15:07:22
STeve
Hallo Nepumuk
Genau das war es.
Natürlich habe ich es noch nicht verstanden :-).......aber Problem dadurch gelöst.
DANKE für deine perfekte und schnelle Antwort.
LG und noch schönes WE
STeve
AW: Nepumuk - Große Klasse
04.06.2017 15:30:15
Daniel
Hi
das ist ganz einfach:
wenn du nach einer Eingabe die Zelle mit TAB, den Cursortasten oder auch Enter (je nach Einstellung) verlässt, dann ändert sich die aktive Zelle. Dh die ActiveCell ist nicht mehr die Zelle die du gerade bearbeitet hast, sondern eben die Nachbarzelle.
Somit ist das TARGET des Change-Events nicht die gleiche Zelle wie die ACTIVECELL
wenn du jetzt also aus dem Change-Event heraus ein anderes Makro aufrufst, um TARGET weiter zu bearbeiten, dann darfst du in diesem Makro nicht AcitveCell verwenden, sondern musst die Information, welche Zelle zu bearbeiten ist, als Parameter an dieses Makro übergeben.
Gruß Daniel
Anzeige
DANKE Daniel ............aaaber ?
05.06.2017 11:12:25
STeve
Hi Daniel.
Danke........ super erklärt - dadurch auch ich verstanden ;-))).
Bin alles mit F8 durchgegangen und habe gesehen dass - mit ActiveZell.Column - immer die falsche Zelle/Spalte angesprochen wurde.
.......aaaaaaaber wie hat es Nepumuk gemacht dass er einfach beim SUB
Private Sub count_values(ByVal countMe As String, ByRef amount As Long, ByVal lngColumn As Long)
....lngColumn einfügte und sofort beim Start dieser Sub die - - - ich glaube diese Variable? - - - :
erkennt dass es sich um die davor angewählte Spalte handelt.
Diese Variable ? ist nirgends Dim.
Also.... das ist mir ein Rätsel?
Vielleicht kann mir das jemand erklären?
mfg und tollen PfingsMO noch an alle.
lg STeve
PS:
VBA wird mich bis an mein Arbeitsende(wahrscheinlich/hoffe nicht - ein Wunder bleiben)beschäftigen!!!
Anzeige
AW: DANKE Daniel ............aaaber ?
05.06.2017 15:43:21
Nepumuk
Hallo,
die Variable wird erst beim Aufruf der Prozedur erzeugt und mit dem Wert aus Target.Column gefüllt. Target ist die geänderte Zelle / der geänderte Bereich. So ganz komplett ist der Code nicht, denn wenn du die Werte in mehrere Zellen gleichzeitig änderst oder löschst wird nur die erste Spalte berücksichtigt. Eigentlich gehört da eine Schleife über alle geänderten Zellen rein.
Gruß
Nepumuk
AW: DANKE Daniel ............aaaber ?
05.06.2017 18:40:12
Daniel
naja, er hat nicht nur diesen zusätzlichen Parameter eingefügt:
Private Sub change_color(ByVal lngColumn As Long)

sondern auch noch beim Aufruf des Makros den entsprechenden Wert angegeben:
Call change_color(Target.Column)
Die Angabe des Parameters in der Kopfzeile der Sub ist quasi die Dimensionierung, dadurch ist die Variable in der Sub bekannt.
Beim Aufruf der Sub mit Call und dem Wert wird diese Variable entsprechend befüllt.
(wobei dir das bekannt sein sollte, da dieses Prinzip ja schon in deiner Ausgangsdatei ins Sub "Count_Values" angewendet wurde und somit nichts neues ist).
Gruß Daniel
Anzeige
Danke Nepumuk und Daniel...noch eine Bitte
05.06.2017 21:45:58
STeve
DANKE an euch beiden.
1.) Daniel: wie ganz am Anfang angegeben ....(Urcode von Max2).... deshalb kenn ich mich nicht so richtig aus ...und schon gar nicht mit den Übergaben von Var. als Parameter.........aber bemühe mich, lerne jeden Tag dazu und hoffe brauche euch nicht mehr zu oft zu belästigen. DANKE nochmal
2.) Nepumuk: .......zitiere dich: wenn du die Werte in mehrere Zellen gleichzeitig änderst oder löschst wird nur die erste Spalte berücksichtigt. Eigentlich gehört da eine Schleife über alle geänderten Zellen rein.......
.....das hab ich gerade auch festgestellt.
Bei den Usern die dann die komplette fertige Datei als Tool verwenden werden, wird natürlich alles vorkommen und sogar sicher dass Einträge über mehrere Spalten/Zellen entfernt/eingetragen werden.
Habe die Datei in fertiger Spaltenanzahl (31) und auch Art der Einträge (18) hier:
https://www.herber.de/bbs/user/114038.xlsm
hochgeladen.
Bitte füge mir die von dir genannte Schleife ein damit die Mehrfach-Löschung/Eintragungen auch funktionieren kann.
In der Hoffnung auf deine Programmierung.
mfg
STeve
Anzeige
AW: Danke Nepumuk und Daniel...noch eine Bitte
06.06.2017 09:56:29
Nepumuk
Hallo,
teste mal:
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim objRange As Range, objCell As Range
    Dim lngRow As Long
    
    Set objRange = Intersect(Target, Range("C2:AG19"))
    
    If Not objRange Is Nothing Then
        
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
        End With
        
        For Each objCell In objRange.Columns
            
            For lngRow = 22 To Cells(Rows.Count, 2).End(xlUp).Row
                
                Cells(lngRow, objCell.Column).Value = count_values(Cells(lngRow, 2).Text, objCell.Column)
                
            Next
            
            Call change_color(objCell.Column)
            
        Next
        
        With Application
            .EnableEvents = True
            .ScreenUpdating = True
        End With
        
        Set objRange = Nothing
        
    End If
End Sub

Private Function count_values(ByVal strSearch As String, ByVal lngColumn As Long) As Long
    
    Dim objCell As Range
    Dim strFirstAddress As String
    
    With Range(Cells(Rows.Count, lngColumn), Cells(1, lngColumn))
        
        Set objCell = .Find(What:=strSearch, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
        
        If Not objCell Is Nothing Then
            
            strFirstAddress = objCell.Address
            
            Do
                
                count_values = count_values + 1
                
                Set objCell = .FindNext(objCell)
                
            Loop Until objCell.Address = strFirstAddress
            
            Set objCell = Nothing
            
        End If
    End With
End Function

Private Sub change_color(ByVal lngColumn As Long)
    
    Dim lngRow As Long, lngTarget As Long, lngActual As Long
    
    For lngRow = 22 To Cells(Rows.Count, 2).End(xlUp).Row
        
        lngTarget = Cells(lngRow, 1).Value
        lngActual = Cells(lngRow, lngColumn).Value
        
        If lngActual = lngTarget Then
            
            Cells(lngRow, lngColumn).Interior.ColorIndex = 4
            
        ElseIf lngActual > lngTarget Then
            
            Cells(lngRow, lngColumn).Interior.ColorIndex = 6
            
        Else
            
            Cells(lngRow, lngColumn).Interior.ColorIndex = 3
            
        End If
    Next
End Sub

Gruß
Nepumuk
Anzeige
DANKE -----Perfekt NEPUMUK
06.06.2017 19:41:46
STeve
Dir noch einen auch so perfekten (wie dein Code)Abend und Tausend Dank.
Funktioniert Klasse und mit einer gewaltigen Geschwindigkeit.
Hoffe du bleibst uns noch lange im Forum mit deiner Unterstützung und Freundlichkeit erhalten.
Habe noch das MatchCase auf False gestellt und er findet auch gemischt klein/groß geschriebenen Eintragungen.
lg STeve

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige