Excel Forum - Porady, Pomoc,  Excel Help, Excel FAQ Strona Główna
 FAQ  RegulaminRegulamin  Szukaj   Użytkownicy   Grupy   Rejestracja   Profil   Twoje wiadomości   Zaloguj 


Poprzedni temat «» Następny temat
ID tematu: 71934 Skopiuj do schowka Przesuń wszystko do góry, jeśli zakres jest pusty
Autor Wiadomość
schuvi 
Exceloholic


Wersja: Win Office 2019
Posty: 161
Wysłany: 25-01-2022, 18:51   

Witam w nowym roku.
Zapomniałem podziękować. Wszystko działa jak powinno. Dziękuję i pozdrawiam
ID posta: 413697 Skopiuj do schowka
 
 
schuvi 
Exceloholic


Wersja: Win Office 2019
Posty: 161
Wysłany: 06-12-2022, 01:33   

Maciej Gonet,

wracając do tematu z przesuwaniem danych. Nieużywałem tego aż do dziś i teraz widzę w czym był wtedy problem
Mianowicie, Twój kod jako tako działla, i to płynnie, ale poprzez to że usuwa wiersze A:M, a potem wstawia je na nowo, psują sie odniesienia w formułach zawartych w kolumnach N:T.
Da się to jakś obejść, by ta operacja nie miała żadnego wpływu na zakres N2:T400?

Wstawiam na nowo plik

Pozdr.

Touren_test3.xlsm
Pobierz Plik ściągnięto 29 raz(y) 313.1 KB

_________________
Wiele nie umiem ale w miarę szybko sie uczę :-)
ID posta: 422943 Skopiuj do schowka
 
 
Tajan


Pomógł: 5441 razy
Posty: 11853
Wysłany: 06-12-2022, 14:41   

Moja propozycja:
Kod:
Sub MoveRowsUp()
    Dim i As Long, j As Long, x As Long, empt As Long
    Dim arr(), rw As Range
    With Range("A2:M400")
        ReDim arr(1 To .Rows.Count, 1 To .Columns.Count)
        For i = 1 To .Rows.Count
            Set rw = .Rows(i).Cells
            If Not Application.CountBlank(rw) = rw.Count Then
                x = x + 1
                For j = 1 To rw.Count
                    arr(x, j) = rw(1, j).Value
                Next
            Else
                empt = empt + 1
            End If
        Next i
        If empt > 0 Then .Value = arr
    End With
End Sub
ID posta: 422953 Skopiuj do schowka
 
 
Maciej Gonet 
Excel Expert


Wersja: Win Office 365
Pomógł: 3434 razy
Posty: 10144
Wysłany: 06-12-2022, 14:43   

Pierwsze rozwiązanie, jakie mi się nasuwa, to zastosowanie odwołań pośrednich w formułach z kolumn N:T, odwołujących się do kolumn A:M.
Lepiej użyć w tym przypadku stylu W1K1, bo w stylu A1 formuł nie da się łatwo kopiować.

Inne możliwe rozwiązanie (nie testowałem), to kopiowanie zamiast usuwania wierszy.
Widzę, że Tajan zaproponował odmianę kopiowania, więc masz już wybór.

Touren_test3_MG.xlsm
Pobierz Plik ściągnięto 20 raz(y) 313.8 KB

ID posta: 422954 Skopiuj do schowka
 
 
schuvi 
Exceloholic


Wersja: Win Office 2019
Posty: 161
Wysłany: 06-12-2022, 18:24   

Panowie: Tajan i Maciej Gonet,

czapki z głów. Dzięki wielkie. Jesteście mistrzowie.

O tych odwołaniach też myślałem, bo generalnie z formułami sobie lepiej radzę ni z vba.
W tym przapadku wybrałem rozwiązanie Tajan-a. Chula pięknie i bezbłędnie.

Mam taką prośbe, bo dla Was to pestka, pisząc kod. Można Was poprosić o komentarze ( 'komentarz) nad funkcjami makr? Pomaga to na przyszlośś. Takową mode myśle że można by generalnie przyjąć na grupie.


Mam jeszcze jedną sprawę w innym wątku. I jestem przekonany ze znajdziecie rozwiązanie. Myśle też że gdybym w tamtym przypadku dysponował komentarzami, może ogarnął bym to sam.

Z wielką przyjemnościa wyślę Wam obojgu po butelce dobrej szkockiej, tylko dajcie adres w wiadomości priv.

Pozdrawiam
_________________
Wiele nie umiem ale w miarę szybko sie uczę :-)
ID posta: 422957 Skopiuj do schowka
 
 
schuvi 
Exceloholic


Wersja: Win Office 2019
Posty: 161
Wysłany: 10-01-2023, 19:00   

Witam ponownie,

mam pytanie odnośnie makra powyżej, które napisał Tajan.
W kolumnie J mam formułę, której nie można kasować. Kolumna ta jest też zablokowana więc formuła jest bezpieczna.
Tak więc wiersz z A:I, K:M musi zostać wyczyszczony by makro zadziałało poprawnie. bo jeśli np K,L,M nie będzie puste, makro odpali ale przesunie tylko puste.
Czy da się tak zrobić, aby makro sprawdziło czy w wierszu który chce przesunąć, jest jakaś nie pusta komórka w kolumnach A:I, K:M? Jeśli jest taka, to msgbox z vbYesNo + vbQuestion Else itd.

Pozdrówka

Kod:
Sub MoveRowsUp()
 
    'Aktualizuj dane / przesuń do góry
    Dim i As Long, j As Long, x As Long, empt As Long
    Dim arr(), rw As Range
    With Range("A2:M400")
        ReDim arr(1 To .Rows.Count, 1 To .Columns.Count)
        For i = 1 To .Rows.Count
            Set rw = .Rows(i).Cells
            If Not Application.CountBlank(rw) = rw.Count Then
                x = x + 1
                For j = 1 To rw.Count
                    arr(x, j) = rw(1, j).Value
                Next
            Else
                empt = empt + 1
            End If
        Next i
        If empt > 0 Then .Value = arr
    End With
End Sub
_________________
Wiele nie umiem ale w miarę szybko sie uczę :-)
ID posta: 424024 Skopiuj do schowka
 
 
Tajan


Pomógł: 5441 razy
Posty: 11853
Wysłany: 10-01-2023, 19:37   

Nie do końca rozumiem problem... Jeżeli w jednym z zakresów, A:I lub K:M, będą wypełnione komórki, to co ma robić makro? Nic nie robić? Przesunąć tylko tam gdzie wszystkie są puste?
I o czym informować i o co pytać ma ten MsgBox?
ID posta: 424027 Skopiuj do schowka
 
 
schuvi 
Exceloholic


Wersja: Win Office 2019
Posty: 161
Wysłany: 10-01-2023, 19:57   

Postaram się lepiej wytłumaczyć.
W A do I, oraz K do M są wartości do ręcznego usuwania. W J wstawiłem formułę która liczy I-H =.
Aby makro poprawnie zadziałało, cały wiersz w A:M musi zostać wyczyszczony. Działa też tak jak powinno. Ale zauważyłem że jeśli
jedna komórka przez przeoczenie nie zostanie wyczyszczona, makro przesunie wszystko do góry o te puste. Efekt jest taki, że mieszają się wtedy dane w poziomach.
Nie mogę zaznaczyć całego wiersza bo w J jest zablokowana formuła.

Makro to ma działać tak jak do tej pory, ale żeby uniknąć różnych przesunięć, chce aby sprawdziło czy w wierszu który został wyczyszczony, nie została przypadkiem wypełniona komórka. W A:M, z czego J pomijamy bo jest tam tylko ukryta formuła. Jeśli coś znajdzie, ma nic nie robić a jedynie odpalić msgbox, z tekstem żeby sprawdzić komórki bo któreś są jeszcze wypełnione.
Mam nadzieję że teraz jest jaśniej.
_________________
Wiele nie umiem ale w miarę szybko sie uczę :-)
ID posta: 424028 Skopiuj do schowka
 
 
Tajan


Pomógł: 5441 razy
Posty: 11853
Wysłany: 10-01-2023, 21:34   

W przypadku mojego makra raczej nie ma możliwości wystąpienia sytuacji o której piszesz. Stąd moje zdziwienie i prośba o doprecyzowanie. Ale ty chyba piszesz o kodzie który na początku zaproponował Maciej? Tam taka możliwość może się pojawić.
Zatem nie rozumiem, czy chcesz zastosować moje makro, czy zmodyfikować procedurę Macieja?
ID posta: 424032 Skopiuj do schowka
 
 
schuvi 
Exceloholic


Wersja: Win Office 2019
Posty: 161
Wysłany: 12-01-2023, 19:42   

Witam,

wstawiłem poprostu msgbox czy napewno wyczyszczone zostały wszystkie komórki.

Ale mam jeszcze dwa pytania:
1. Po wstawieniu formuły do kolumny J, makro generalnie nie chce ruszyć. Usunę formułę, makro przesuwa do góry tak jak należy. Czy można go nauczyć, żeby pomijał kolumnę 10(J)?
2 Drugie pytanie to: jeśli komórki wiersza w kolumnach od lewej a,b,c,d itd.zostaną wyczyszczone i uruchomione makro, pojawi się mój msgbox z pytaniem jak wyżej, czy makro mogło by w tym momencie zaznaczyć kolorem cały wiersz do przesunięcia, a po komendzie OK, znikło zaznaczenie i makro doszło do końca?

Pozdrawiam
_________________
Wiele nie umiem ale w miarę szybko sie uczę :-)
ID posta: 424123 Skopiuj do schowka
 
 
Tajan


Pomógł: 5441 razy
Posty: 11853
Wysłany: 12-01-2023, 21:52   

1. Wypróbuj taki kod:
Kod:
Sub MoveRowsUp()
    'Aktualizuj dane / przesuń do góry
    Dim i As Long, j As Long, x As Long, empt As Long
    Dim arr(), rw As Range
   
    With Range("A2:M400")
       
        ReDim arr(1 To .Rows.Count, 1 To .Columns.Count)
       
        For i = 1 To .Rows.Count
            Set rw = .Rows(i).Cells
            If Application.CountA(rw.Range("a1:i1")) > 0 Or _
               Application.CountA(rw.Range("k1:m1")) > 0 Then
                x = x + 1
                For j = 1 To rw.Count
                    arr(x, j) = rw(1, j).Value
                Next
            End If
        Next i
   
        If x > 0 Then
            For i = 1 To 13
                If i <> 10 Then
                   .Columns(i).Cells.Value = Application.Index(arr, 0, i)
                End If
            Next
        End If
   
        End With

End Sub

ID posta: 424131 Skopiuj do schowka
 
 
schuvi 
Exceloholic


Wersja: Win Office 2019
Posty: 161
Wysłany: 13-01-2023, 11:55   

Tajan,

działa, i to tak jak chciałem ostatnio. Trochę nie płynnie, ale robi co trzeba.
Jeśli któraś z komórek nie jest wyczyszczona, makro nie ruszy. Super.
Teraz jeszcze jedno... gdy do tego dojdzie, że któraś nie jest pusta, i makro nie ruszy, to gdzie tu wstawić msgbox > nie wszystkie komorki sa puste i po OK przerwać makro?
_________________
Wiele nie umiem ale w miarę szybko sie uczę :-)
ID posta: 424157 Skopiuj do schowka
 
 
Tajan


Pomógł: 5441 razy
Posty: 11853
Wysłany: 13-01-2023, 12:39   

Czyli należy przyjąć, że jeżeli chociażby jedna komórka jest pusta a pozostałe wypełnione, to makro ma wyświetlić komunikat i zakończyć działanie?
ID posta: 424160 Skopiuj do schowka
 
 
schuvi 
Exceloholic


Wersja: Win Office 2019
Posty: 161
Wysłany: 13-01-2023, 13:48   

Bezpieczniej inaczej: Komórki w A, C i D zawsze będą wypełniane, pozostałe niekoniecznie. Więc mogłoby być tak, że jeśli A jest puste, a jakaś pozostała w wierszu (poza J bo to formuła) wypełniona, to komunikat i przerwać Makro.
A jeszcze wybitniej by było gdyby wtedy wypełniło cały wiersz A:M jakimś kolorem, na czas do OK.
_________________
Wiele nie umiem ale w miarę szybko sie uczę :-)
ID posta: 424164 Skopiuj do schowka
 
 
Tajan


Pomógł: 5441 razy
Posty: 11853
Wysłany: 13-01-2023, 16:12   

No, to może tak:
Kod:
Sub MoveRowsUp()
    'Aktualizuj dane / przesuń do góry
    Dim i As Long, j As Long, x As Long, empt As Range
    Dim arr(), rw As Range
   
    With Range("A2:M400")
       
        ReDim arr(1 To .Rows.Count, 1 To .Columns.Count)
       
        For i = 1 To .Rows.Count
           
            With .Rows(i).Cells
                Set rw = Union(.Range("a1:i1"), .Range("k1:m1"))
            End With
           
            If Application.CountA(rw) > 0 Then
               
                If .Cells(i, 1).Value = "" Then
                    Application.Goto rw
                    MsgBox "Nie wszystkie komórki zostały wyczyszczone!"
                    Exit Sub
                End If
               
                x = x + 1
               
                For j = 1 To .Columns.Count
                    arr(x, j) = .Cells(1, j).Value
                Next
            Else
                Set empt = Union(IIf(empt Is Nothing, .Rows(i), empt), .Rows(i))
            End If
           
        Next
   
        If Not empt Is Nothing Then
            For i = 1 To .Columns.Count
                If i <> 10 Then
                    .Columns(i).Cells.Value = Application.Index(arr, 0, i)
                End If
            Next
        End If
   
    End With

End Sub
Nie koloruję komórek. Po prostu zaznaczam wiersz który nie jest całkowicie pusty.
ID posta: 424167 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Odpowiedz do tematu
Nie możesz pisać nowych tematów
Nie możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Nie możesz załączać plików na tym forum
Możesz ściągać załączniki na tym forum
Dodaj temat do Ulubionych
Wersja do druku

Skocz do:  

Powered by phpBB modified by Przemo © 2003 phpBB Group
Theme xandgreen created by spleen& Programosy modified v0.3 by warna
Opieka techniczna www.wip.pl

Archiwum

Strona uĹźywa plikĂłw cookies.

Kliknij tutaj, żeby dowiedzieć się jaki jest cel używania cookies oraz jak zmienić ustawienia cookie w przegl�darce.
Korzystając ze strony użytkownik wyraża zgodę na używanie plików cookies, zgodnie z bieżącymi ustawieniami przeglądarki.
SprawdĹş, w jaki sposĂłb przetwarzamy dane osobowe