Visual Basic - VBA usuwanie wypełnienia gdzie ono jest ustawione

Cisi204

2020-03-05 08:23

Cisi2042020-03-05 08:23

Rejestracja:prawie 7 lat
Ostatnio:prawie 2 lata
Postów:232

0

Witam , jeśli piszę w złym dziale proszę o przeniesienie tematu. Otóż mam taki problemik , mam sobie pewne dane w Excelu , które są wypełniane na kolor żółty po znalezieniu określonego słowa przez formatowanie warunkowe , chciałbym aby wszystkie wiersze które mają wypełnienie koloru żółtego został usunięte. Oto mój kod który ma za zadanie czyścić 'celle ' w wierszu gdzie jest wypełnienie żółte

Kod który wypisuje poszczególne oznaczenia na danych kolorów.

Kopiuj

Sub kolory ()
For w = 1 To 56
Cells(w, 7).Value = w
Cells(w, 8).Interior.ColorIndex = w
Next
End Sub

Kod który ma za zadanie znaleźć , wszystkie rekordu ,które mają żólte wypełnienie i usunąć te wiersze.

Kopiuj

Sub rvfcc()
'remove values from colored cells
        Range("A1: AB100").Select
        For Each Cell In Selection
        For w = 1 To 100
        If Cells(w, 3).Interior.ColorIndex=6 (lub 27 bo taki index mają w powyższym kodzie kolory żólte) Then
        Cell.Clear
        End If
        Next

    End Sub

Kod który ma za zadanie usunąć wszystkie wiersze w których są 'pustki '

Kopiuj


Sub Usun_puste_wiersze()
  Dim Zakres As Range, Kolumna As Range, Komorka As Range
  Dim Licznik As Long, LiczbaKomorek As Long, Usunietych As Long

  'UWAGA! Zaznacz dowolną komórkę w zakresie, który ma zostać oczyszczony
  Set Zakres = ActiveCell.CurrentRegion
  Set Kolumna = Zakres.Columns(3)
  LiczbaKomorek = Zakres.Rows.Count

  Usunietych = 0
  For Licznik = 1 To LiczbaKomorek
     Set Komorka = Kolumna.Cells(Licznik - Usunietych, 1)
     If Komorka.Value = 0 Then
        Rows(Licznik - Usunietych).Delete
        Usunietych = Usunietych + 1
     End If
  Next Licznik

  Set Zakres = Nothing
  Set Kolumna = Nothing
  Set Komorka = Nothing
End Sub

Problem jest taki że to nie działa , wiecie może jak to ugryźć , nie jestem jakimś specjalista od VBA lecz taką automatyzację dobrze znać. Wiem że ten kod jest trochę na skróty .

edytowany 2x, ostatnio: Ktos 2020-03-08 17:26

Lukas Kordel

2020-03-06 19:16

Lukas Kordel2020-03-06 19:16

Rejestracja:około 5 lat
Ostatnio:około 4 lata
Postów:4

0

Napisałbym to w ten sposób.

Ten kod usunie z wcześniej zaznaczonego przez Ciebie obszaru wszystkie wiersze w których występują komórki z ustawionym ColorIndex = 27 i ColorIndex = 6.. Przed usunięciem zaznaczy wiersze do usunięcia i wyśle zapytanie.

Kopiuj

Sub UsunWierszeZKoloremZaznacz()

            Dim toRemove As String

            For Each CELL In Selection
                                 
                Select Case CELL.Interior.ColorIndex
                    
                    Case 6, 27:
                    If InStr(1, toRemove, "A" & CELL.Row) = 0 Then
                        
                        toRemove = toRemove & "A" & CELL.Row & ","
                    End If
                End Select
                
            Next CELL
            
           If toRemove = "" Then Exit Sub
           
           Range(Left(toRemove, Len(toRemove) - 1)).EntireRow.Select
           
           If MsgBox("Czy usunąć zaznaczone wiersze?", vbYesNo) = vbYes Then
                
                 Range(Left(toRemove, Len(toRemove) - 1)).EntireRow.Delete
           End If
           
End Sub

lub użyj tego jeżeli chcesz usunąć bez weryfikacji ...

Kopiuj

Sub UsunWierszeZKolorem()

            Dim toRemove As String

            For Each CELL In Selection
                                 
                Select Case CELL.Interior.ColorIndex
                    
                    Case 6, 27:
                    If InStr(1, toRemove, "A" & CELL.Row) = 0 Then
                        
                        toRemove = toRemove & "A" & CELL.Row & ","
                    End If
                End Select
                
            Next CELL
            
           If toRemove <> "" Then Range(Left(toRemove, Len(toRemove) - 1)).EntireRow.Delete
                     
End Sub

Cisi204

2020-03-09 08:47

Cisi2042020-03-09 08:47

Rejestracja:prawie 7 lat
Ostatnio:prawie 2 lata
Postów:232

0

lub użyj tego jeżeli chcesz usunąć bez weryfikacji ...

Kopiuj

Sub UsunWierszeZKolorem()

            Dim toRemove As String

            For Each CELL In Selection
                                 
                Select Case CELL.Interior.ColorIndex
                    
                    Case 6, 27:
                    If InStr(1, toRemove, "A" & CELL.Row) = 0 Then
                        
                        toRemove = toRemove & "A" & CELL.Row & ","
                    End If
                End Select
                
            Next CELL
            
           If toRemove <> "" Then Range(Left(toRemove, Len(toRemove) - 1)).EntireRow.Delete
                     
End Sub

Dziękuje za szybką a wręcz błyskawiczną odpowiedz , jak na temat 'inny język programowania' :) .Wybieram opcję bez weryfikacji , lecz mam drobny problem z tym kodem ponieważ próbuję ustalić zasięg na jaki ten kod ma działać , w moim przypadku dane wypełnione kolorem zółtym znajduję się w kolumnie 'C' .
Swój kod przerobiłem w ten sposób aby przeszukiwał wszystkie kolumny w danym zakresie.

Kopiuj

Sub UsunWierszeZKolorem()

            Dim toRemove As String

            Range("A1: AB1").Select
            For Each CELL In Selection

                Select Case CELL.Interior.ColorIndex

                    Case 6, 27:
                    If InStr(1, toRemove, "A" & CELL.Row) = 0 Then

                        toRemove = toRemove & "A" & CELL.Row & ","
                    End If
                End Select

            Next CELL

           If toRemove <> "" Then Range(Left(toRemove, Len(toRemove) - 1)).EntireRow.Delete

End Sub

, kod powyżej Szuka w zakresie od A1 do AB1 , i moje pytanie brzmi jak rozumieć ten warunek

Kopiuj

 If InStr(1, toRemove, "A" & CELL.Row) = 0 Then

jeśli 1 usuń , i co oznacza te 'A' oraz '&Cell.row ' jak to interpretować

Lukas Kordel

2020-03-09 16:21

Lukas Kordel2020-03-09 16:21

Rejestracja:około 5 lat
Ostatnio:około 4 lata
Postów:4

0

, kod powyżej Szuka w zakresie od A1 do AB1 , i moje pytanie brzmi jak rozumieć ten warunek
Kopiuj
 If InStr(1, toRemove, "A" & CELL.Row) = 0 Then 
jeśli 1 usuń , i co oznacza te 'A' oraz '&Cell.row ' jak to interpretować

ten warunek sprawdza czy (w wyznaczonym przez Ciebie obszarze)w wierszu o nr "CELL.Row" znajduje się już komórka z kolorem który wybrałeś. Jeżeli tak to ją zignoruje. Tak żeby w zbudowanym zaznaczeniu nie powtarzały się numery wierszy które mają zostać usunięte.

Literka "A" jest potrzebna aby zbudować zaznaczenie na podstawie którego na końcu skrypt określi które wiersze są do usunięcia.
Inaczej możesz wprowadzić w miejsce tej literki każdą inną literkę. Nie będzie miało to wpływu na działanie skryptu.
(cyfra 1 oznacza że ma przeszukać ciąg licząc od pierwszego znaku)

edytowany 1x, ostatnio: Lukas Kordel 2020-03-09 16:33

Cisi204

2020-03-10 10:12

Cisi2042020-03-10 10:12

Rejestracja:prawie 7 lat
Ostatnio:prawie 2 lata
Postów:232

0

Nie wiem czy dobrze kombinuję mam taki oto kod z którym mam problem, ponieważ nie działa .

Kopiuj

Sub UsunWierszeZKolorem()

            Dim toRemove As String
            Range("C1:C250").Select
            For Each CELL In Selection

                Select Case CELL.Interior.ColorIndex

                    Case 6, 27:
                    If InStr(1, toRemove, "A" & ("A2:A250")) = 0 Then

                        toRemove = toRemove & "A" & CELL.Row & ","
                    End If
                End Select

            Next CELL

           If toRemove <> "" Then Range(Left(toRemove, Len(toRemove) - 1)).EntireRow.Delete

End Sub

Na samym początku zdefiniowałem obszar dla których ma mi sprawdzać kolumny , z uwagi że te dane mam w kolumnie "C" obszar zdefiniowałem aby sprawdzał od "C1:C250" , i chciałbym aby sprawdzał mi wiersze od A2 do A250 . Czy ktoś może doradzić czemu to nie działa ? i jakoś nakierować co jest nie tak i jak to poprawić. Z góry dziękuję za pomoc.

edytowany 1x, ostatnio: Cisi204 2020-03-10 10:12

Cisi204

2020-03-10 10:32

Cisi2042020-03-10 10:32

Rejestracja:prawie 7 lat
Ostatnio:prawie 2 lata
Postów:232

0

Zmniejszyłem trochę zasięg , kod nadal nie działa , tylko zaznacza te obszaru , efektu usunięcia brak.

Kopiuj

Sub UsunWierszeZKolorem()

            Dim toRemove As String
             Range("C2:C10").Select
            For Each CELL In Selection
            
                Select Case CELL.Interior.ColorIndex

                    Case 6, 27:
                    If InStr(1, toRemove, "A" & Rows("2:10").Select) = 0 Then

                        toRemove = toRemove & "A" & CELL.Row & ","
                    End If
                End Select

            Next CELL

           If toRemove <> "" Then Range(Left(toRemove, Len(toRemove) - 1)).EntireRow.Delete

End Sub

Marcin.Miga

2020-03-10 12:31

Marcin.Miga2020-03-10 12:31

Rejestracja:prawie 17 lat
Ostatnio:2 dni
Postów:2792

0

A to: (trochę uprościłem kod)

Kopiuj

Sub UsunWierszeZKolorem()
Dim toRemove As String
             
For Each cell In Range("C2:C10")

    Select Case cell.Interior.Color
        Case vbYellow: ' ten drugi to nie wiem
           toRemove = toRemove & "A" & cell.Row & ","
    End Select

Next cell

If toRemove <> "" Then Range(Left(toRemove, Len(toRemove) - 1)).EntireRow.Delete

End Sub

?

Cisi204 2020-03-10 12:36

tez niestety nie działa , do case dodałem jeszcze 2,7 , bo w tej palecie barw warunkowe oznaczenie żółte ma takie id koloru "Case 6, 27":

Marcin.Miga

2020-03-10 13:09

Marcin.Miga2020-03-10 13:09

Rejestracja:prawie 17 lat
Ostatnio:2 dni
Postów:2792

0

Przed końcowym if wpisz:

Kopiuj

MsgBox toRemove

i zobacz, co ci wyświetla.

Cisi204 2020-03-10 13:59

Wyskakuje tylko puste okno , bez komunikatu z nagłówkiem Microsoft Excel

Marcin.Miga 2020-03-10 15:04

Skoro tak jest, to odpowiedź jest prosta: Nie masz w danym obszarze żadnych komórek o kolorze tła = 6 lub =27

Lukas Kordel

2020-03-10 14:39

Lukas Kordel2020-03-10 14:39

Rejestracja:około 5 lat
Ostatnio:około 4 lata
Postów:4

0

"> Na samym początku zdefiniowałem obszar dla których ma mi sprawdzać kolumny , z uwagi że te dane mam w kolumnie "C" obszar zdefiniowałem aby sprawdzał od "C1:C250" , i chciałbym aby sprawdzał mi wiersze od A2 do A250 . Czy ktoś może doradzić czemu to nie działa ? i jakoś nakierować co jest nie tak i jak to poprawić. Z góry dziękuję za pomoc."

Obszar przeszukiwania modyfikujesz tylko przed wejściem do pętli. (4 wiersz)
Nie modyfikujesz warunku wewnątrz pętli.

Nie jestem pewien czy dobrze Ciebie rozumiem.
Kod poniżej usunie wszystkie wiersze jeżeli w kolumnie A lub C dla wiersza od 1 do 250 wystąpią komórki z ustawionym "Interior.ColorIndex" 6 lub 27.

Kopiuj

Sub UsunWierszeZKolorem()

            Dim toRemove As String
            Range("A1:A250,C1:C250").Select 
           
            For Each CELL In Selection

                Select Case CELL.Interior.ColorIndex

                    Case 6, 27:
                    If InStr(1, toRemove, "A" & CELL.Row) = 0 Then

                        toRemove = toRemove & "A" & CELL.Row & ","
                    End If
                End Select

            Next CELL

           If toRemove <> "" Then Range(Left(toRemove, Len(toRemove) - 1)).EntireRow.Delete

End Sub

jeżeli chcesz przeszukać tylko kolumnę C to w 4 wierszu zmien zaznaczenie na :

Kopiuj

Range("C1:C250").Select

edytowany 3x, ostatnio: Lukas Kordel 2020-03-10 14:43

Marcin.Miga

2020-03-10 15:17

Marcin.Miga2020-03-10 15:17

Rejestracja:prawie 17 lat
Ostatnio:2 dni
Postów:2792

0

Już wiem ....
Twój komentarz mnie nakierował

tez niestety nie działa , do case dodałem jeszcze 2,7 , bo w tej palecie barw warunkowe oznaczenie żółte ma takie id koloru "Case 6, 27"

Skoro, to jest formatowanie warunkowe, to sprawdż:
Cell.DisplayFormat.Interior.ColorIndex
:)

edytowany 1x, ostatnio: Marcin.Miga 2020-03-10 15:17

Cisi204

2020-03-11 06:46

Cisi2042020-03-11 06:46

Rejestracja:prawie 7 lat
Ostatnio:prawie 2 lata
Postów:232

0

Śmiga

Kopiuj

Sub UsunWierszeZKolorem()

            Dim toRemove As String
           Range("C1:C250").Select

            For Each Cell In Selection

                Select Case Cell.DisplayFormat.Interior.ColorIndex

                    Case 6, 27:
                    If InStr(1, toRemove, "A" & Cell.Row) = 0 Then

                        toRemove = toRemove & "A" & Cell.Row & ","
                    End If
                End Select

            Next Cell

           If toRemove <> "" Then Range(Left(toRemove, Len(toRemove) - 1)).EntireRow.Delete

End Sub

Cell.DisplayFormat.Interior.ColorIndex lekiem na całe zło

edytowany 1x, ostatnio: Cisi204 2020-03-11 06:59

Lukas Kordel

2020-03-11 12:55

Lukas Kordel2020-03-11 12:55

Rejestracja:około 5 lat
Ostatnio:około 4 lata
Postów:4

0

hmm też niedoczytałem że to formatowanie warunkowe

podmien bo bedą błedy (dodałem przecinek do warunku)

Kopiuj

If InStr(1, toRemove, "A" & cell.Row & ",") = 0 Then

... o ile dobrze pamiętam argument dla "range" przyjmuje do 255 znaków więc możesz z łatwością przekroczyć ten limit jeżeli tych żółtych komórek będzie sporo.
Lepiej będzie usunąć je w pętli ...

tak na szybko ....np tak

Kopiuj

            If toRemove = "" Then Exit Sub
                
                toRemove = Replace(toRemove, "A", "")
                Dim rows_() As String: rows_ = Split(toRemove, ",")
                Dim n_row As Integer: n_row = UBound(Split(toRemove, ","))
                
                For i = n_row - 1 To LBound(rows_) Step -1
                    
                      rows(CInt(rows_(i))).Delete
                      
                Next i

nie testowałem ale powinno działać.

Visual Basic - VBA usuwanie wypełnienia gdzie ono jest ustawione

Cisi204

Lukas Kordel

Cisi204

Lukas Kordel

Cisi204

Cisi204

Marcin.Miga

Marcin.Miga

Lukas Kordel

Marcin.Miga

Cisi204

Lukas Kordel

Programista Systemów Automatyki - PCS7

PHP + Codeigniter 4 programista, aplikacja do fakturowania

DevOps Engineer - migracja serwerów (Kubernetes,Docker,RoR)

Praca dla programistów

Forum dyskusyjne

Sprawy administracyjne

O nas

Skontaktuj się z nami