Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1312to1316
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

Zellinhalte simultan löschen

Zellinhalte simultan löschen
25.05.2013 19:43:24
Andreas
Hallo,
ich habe folgendes Problem, bei dem ich mit meinen VBA-Kenntnissen leider nicht weiterkomme:
In der Datei unter folgendem Link
https://www.herber.de/bbs/user/85521.xlsx
Nun möchte ich gerne folgendes realisieren:
Die Zellinhalte (in diesem Beispiel Tiere) aus den Bereichen A bis H tauchen in zufälliger Aufteilung in den Bereichen 1 - 4 oben wieder auf. Jeder Eintrag kommt dabei sowohl in den Bereichen 1-4 als auch A-H jeweils nur einmal vor.
Wird nun ein Zellinhalt (z.B. "Löwe") gelöscht (z.B. durch direktes löschen durch Klick auf die jeweilige Zelle und drücken von "Del" oder "Entf" auf der Tastatur), soll der identische Zellinhalt gleichzeitig auch aus den Bereichen A bis H gelöscht werden.
Beispiel: Wird der Zellinhalt "Löwe" aus Zelle F8 gelöscht, soll der identische Zellinhalt "Löwe" gleichzeitig aus Zelle C47 in Bereich "E" gelöscht.
Ok wäre auch, neben die einzelnen Zellen in den Bereichen 1-4 jeweils einen Lösch-Button zu platzieren oder ein "x" zu setzen, wenn der jeweilige Zellinhalt gelöscht werden soll (z.B. bei Eintrag eines "x" in Zelle G8 neben Zelle F8 mit Zellinhalt "Löwe".
Ich hoffe, ich konnte das Problem einigermaßen beschreiben.
Über eine gute Idee würde ich mich sehr freuen!
Viele Grüße
Andreas

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

Betreff
Datum
Anwender
Anzeige
AW: Zellinhalte simultan löschen
25.05.2013 20:23:59
Tino
Hallo,
ich habe es mal so versucht.
Die Datei müsstest Du als *.xlsm, .xls oder .xlsb speichern, .xlsx kann kein VBA.
kommt als Code in Prioritäten_Neu
Option Explicit 
 
 
Private Sub Worksheet_Change(ByVal Target As Range) 
Dim rng As Range, tmpRng As Range 
If Not Target(1, 1) = Empty Then Exit Sub 
 
With Application 
    .EnableEvents = False 
    .ScreenUpdating = False 
    .Undo 
         
        For Each rng In Target.Cells 
           If Not rng = Empty Then 
                Set tmpRng = Range("B5:L65").Find(What:=rng.Value, LookIn:=xlValues, _
                             LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                             MatchCase:=False, SearchFormat:=False) 
                              
                Do While Not tmpRng Is Nothing 
                    tmpRng.Value = Empty 
                    Set tmpRng = Range("B5:L65").FindNext(tmpRng) 
                Loop 
           End If 
        Next rng 
     
    .ScreenUpdating = True 
    .EnableEvents = True 
End With 
End Sub 
 
Gruß Tino

Anzeige
AW: Zellinhalte simultan löschen
25.05.2013 21:26:43
Tino
Hallo,
etwas erweitert.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, tmpRng As Range, rngBereich As Range

With Application.CommandBars("Edit").Controls(1)
    If InStr(LCase(.Caption), "löschen") = 0 And InStr(LCase(.Caption), "delete") = 0 Then Exit Sub
End With

'hier den zu überwachenden Bereich anpassen 
Set rngBereich = Range("B5:L65")

Set rng = Intersect(rngBereich, Target)
If rng Is Nothing Then Exit Sub
If Not rng.Cells(1, 1) = Empty Then Exit Sub

With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .Undo
        
        For Each rng In rng.Cells
           If Not rng = Empty Then
                Set tmpRng = rngBereich.Find(What:=rng.Value, LookIn:=xlValues, _
                             LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                             MatchCase:=False, SearchFormat:=False)
                             
                Do While Not tmpRng Is Nothing
                    tmpRng.Value = Empty
                    Set tmpRng = Range("B5:L65").FindNext(tmpRng)
                Loop
           End If
        Next rng
    
    .ScreenUpdating = True
    .EnableEvents = True
End With

End Sub
Gruß Tino

Anzeige
AW: Zellinhalte simultan löschen
26.05.2013 08:43:27
Andreas
Hallo Tino,
Genial! Funktioniert perfekt und genau so, wie ich es mir vorgestellt habe!
Vielen vielen Dank für deine Mühe!
Viele Grüße
Andreas

AW: Zellinhalte simultan löschen
26.05.2013 09:47:47
Tino
Hallo,
evtl. sollten wir in der Zeile Set tmpRng = rngBereich.Find... aus
LookAt:=xlPart
LookAt:=xlWhole
machen, damit bei der Suche der gesamte Inhalt verglichen wird.
Gruß Tino

AW: Zellinhalte simultan löschen
27.05.2013 08:50:47
Andreas
Hallo Tino,
das ist eine gute Idee. Ich habe das noch angepasst.
Funktioniert wirklich wunderbar!
Eine kleine Verbesserung ist mir noch eingefallen, vielleicht hast du dazu noch eine gute Idee:
Optimal wäre, wenn die Zellinhalte in den unteren Zellbereichen A-G "nachrücken" würden, d.h. wenn oben eine Zellinhalt gelöscht wird (der ja dann in einem der unteren Bereiche nun wunderbar simultan mitgelöscht wird), wäre es genial, wenn die entstandene Lücke geschlossen wird, indem darunterliegende Zellinhalte alle eine Zelle nach oben wandern (also sozusagen aufrücken).
Dabei sollen die Zellbereiche selbst unverändert bleiben (also nur der Inhalt eine Zelle nach oben kopiert werden).
Meinst du, so was ließe sich noch realisieren?
Falls dir da noch eine gute Lösung einfällt, wäre das genial!
Viele Grüße
Andreas

Anzeige
AW: Zellinhalte simultan löschen
27.05.2013 10:41:21
Tino
Hallo,
teste mal diesen Code.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, tmpRng As Range, rngBereich As Range
Dim nOffset&, strBereichAufruecken$
Dim SuchBergriffe(), varSuchBergriff
'im Bereich "B5:L22,C26:L44,C47:L65" aufrücken evtl. anpassen ********** 
strBereichAufruecken = "B5:L22,C26:L44,C47:L65"

With Application.CommandBars("Edit").Controls(1)
    If InStr(LCase(.Caption), "löschen") = 0 And InStr(LCase(.Caption), "delete") = 0 Then Exit Sub
End With

'hier den zu überwachenden Bereich anpassen 
Set rngBereich = Range("B5:L65")

Set rng = Intersect(rngBereich, Target)
If rng Is Nothing Then Exit Sub

With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .Undo
        Redim Preserve SuchBergriffe(rng.Cells.Count - 1)
        For Each rng In rng.Cells
            SuchBergriffe(nOffset) = rng.Value
            nOffset = nOffset + 1
        Next rng
        For Each varSuchBergriff In SuchBergriffe
               If varSuchBergriff <> "" Then
                    Set tmpRng = rngBereich.Find(What:=varSuchBergriff, LookIn:=xlValues, _
                                 LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                 MatchCase:=False, SearchFormat:=False)
                                 
                    Do While Not tmpRng Is Nothing
                        tmpRng.Value = Empty
                        If Not Intersect(Range(strBereichAufruecken), tmpRng) Is Nothing Then
                            nOffset = 1
                            Do While InStr(tmpRng.Offset(nOffset, 0), "Bereich") = 0
                                tmpRng.Offset(nOffset - 1, 0).Value = tmpRng.Offset(nOffset, 0).Value
                                tmpRng.Offset(nOffset, 0).Value = Empty
                                nOffset = nOffset + 1
                                If Intersect(Range(strBereichAufruecken), tmpRng.Offset(nOffset, 0)) Is Nothing Then Exit Do
                            Loop
                        End If
                        Set tmpRng = Range("B5:L65").FindNext(tmpRng)
                    Loop
               End If
        Next varSuchBergriff
    .ScreenUpdating = True
    .EnableEvents = True
End With

End Sub
Gruß Tino

Anzeige
AW: Zellinhalte simultan löschen
27.05.2013 11:17:51
Andreas
Hallo Tino,
perfekt! Funktioniert genauso wie ich es gehofft hatte!
Wirklich Spitzenklasse!
Vielen vielen Dank nochmal für die großartige Unterstützung!
Viele Grüße und bis vielleicht bald mal wieder im Forum,
Andreas

AW: Zellinhalte simultan löschen
26.05.2013 00:52:58
Erich
Hi Andreas,
auch dieser Code (gehört in den Code der Tabelle, also nicht in ein normales Modul)
könnte das Gewünschte tun:

Option Explicit
Dim strAlt As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Target
If .Count > 1 Then Exit Sub
If Target.Row  22 Then Exit Sub
If Target.Column  15 Then Exit Sub
If Target.Column Mod 3  0 Then Exit Sub
strAlt = .Value
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngFound As Range, lngR As Long, lngAnz As Long
With Target
If .Count > 1 Then Exit Sub
If strAlt = "" Or .Value  "" Then Exit Sub
If .Row  22 Then Exit Sub
If .Column  15 Then Exit Sub
If .Column Mod 3  0 Then Exit Sub
End With
Application.EnableEvents = False
With Range(Cells(26, 3), Cells(65, 12))
Set rngFound = .Find(strAlt, , xlValues, xlWhole, _
MatchCase:=False, SearchFormat:=False)
Do While Not rngFound Is Nothing
lngR = rngFound.Row
lngAnz = 45 - lngR - 21 * (lngR > 45)
Cells(lngR, rngFound.Column).Resize(lngAnz) = _
Cells(lngR + 1, rngFound.Column).Resize(lngAnz).Value
Set rngFound = .FindNext(rngFound)
Loop
End With
Application.EnableEvents = True
End Sub
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich

Anzeige
AW: Zellinhalte simultan löschen
26.05.2013 19:32:24
Andreas
Hallo Erich,
vielen Dank für den Vorschlag! Das sieht sehr interessant aus.
Ich werde den Code morgen testen und gebe dann gerne eine Rückmeldung!
Viele Grüße und einen schönen Sonntag abend!
Andreas

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige