Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Przesuń wszystko do góry, jeśli zakres jest pusty

schuvi · Exceloholic Wersja: Win Office 2019 Posty: 158

Witam w nowym roku.
Zapomniałem podziękować. Wszystko działa jak powinno. Dziękuję i pozdrawiam

schuvi · Exceloholic Wersja: Win Office 2019 Posty: 158

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 15 raz(y) 313.1 KB

Tajan · **Pomógł:** 5234 razy Posty: 11412

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

Maciej Gonet · 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 7 raz(y) 313.8 KB

schuvi · Exceloholic Wersja: Win Office 2019 Posty: 158

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

schuvi · Exceloholic Wersja: Win Office 2019 Posty: 158

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

Tajan · **Pomógł:** 5234 razy Posty: 11412

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?

schuvi · Exceloholic Wersja: Win Office 2019 Posty: 158

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.

Tajan · **Pomógł:** 5234 razy Posty: 11412

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?

schuvi · Exceloholic Wersja: Win Office 2019 Posty: 158

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

Tajan · **Pomógł:** 5234 razy Posty: 11412

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

schuvi · Exceloholic Wersja: Win Office 2019 Posty: 158

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?

Tajan · **Pomógł:** 5234 razy Posty: 11412

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?

schuvi · Exceloholic Wersja: Win Office 2019 Posty: 158

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.

Tajan · **Pomógł:** 5234 razy Posty: 11412

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.