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: 68628 Skopiuj do schowka Odczytanie brakujących liczb w kolumnie
Autor Wiadomość
Marcindworzan
Stały bywalec Excelforum


Wersja: Win Office 2010
Posty: 308
Wysłany: 02-08-2020, 11:38   Odczytanie brakujących liczb w kolumnie

Witam,
w załączniku umieściłem przykład, w którym od komórki A1 w dół wpisywane są kolejno narastające liczby (kolumna A stale się rozrasta). W jaki sposób zmodyfikować poniższy kod (który znalazłem tutaj na forum), aby ostatecznie w komunikacie podawało mi te numery (np w słupku), których brakuje?

Edit: poniższy kod dotyczy ciągu, który jest wpisywany po przecinku, co mnie nie urządza niestety...

Kod:
Sub liczby()
Dim i As Integer, tabl, j As Integer, komunikat As String
tabl = Split(Cells(1, 1), ",")

For i = 1 To UBound(tabl)
If CDbl(tabl(i - 1)) + 1 <> CDbl(tabl(i)) Then
    komunikat = komunikat & Chr(10) & tabl(j) & " - " & tabl(i - 1)
            j = i
                End If
Next i
If tabl(j) <> tabl(i - 1) Then
    komunikat = komunikat & Chr(10) & tabl(j) & " - " & tabl(i - 1)
        Else
            komunikat = komunikat & Chr(10) & tabl(i - 1)
                End If
MsgBox komunikat
End Sub


Przykład.xlsx
Pobierz Plik ściągnięto 8 raz(y) 8.13 KB

ID posta: 390389 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 720 razy
Posty: 3878
Wysłany: 02-08-2020, 12:33   

"brakuje" - czyli pusta komórka?
_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
Chcesz precyzyjną odpowiedź - zadaj precyzyjne pytanie.
ID posta: 390390 Skopiuj do schowka
 
 
Marcindworzan
Stały bywalec Excelforum


Wersja: Win Office 2010
Posty: 308
Wysłany: 02-08-2020, 12:40   

@umiejead - brakuje, czyli pominięto numer (tak jak w załączniku)
ID posta: 390391 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 720 razy
Posty: 3878
Wysłany: 02-08-2020, 12:54   

Kod:
Option Explicit

Private Sub CommandButton1_Click()
Dim i&, p&

i = 1
p = Cells(i, 1).Value

Do Until Cells(i, 1).Value = ""
    If Cells(i + 1, 1).Value <> p + 1 Then
        Cells(i + 1, 2).Value = "Błąd!"
        i = i + 1
        p = Cells(i, 1).Value
    Else
        i = i + 1
        p = Cells(i, 1).Value
    End If
Loop
   
Cells(i, 2).Value = ""

End Sub
_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
Chcesz precyzyjną odpowiedź - zadaj precyzyjne pytanie.
ID posta: 390393 Skopiuj do schowka
 
 
Marcindworzan
Stały bywalec Excelforum


Wersja: Win Office 2010
Posty: 308
Wysłany: 02-08-2020, 13:08   

@umiejead dzięki :) chociaż najlepiej by było, aby nie wykorzystywało kolumny B na wpisywanie błędu, gdyż w tej kolumnie (i w pozostałych) są inne informacje, których na potrzeby przykładu nie zamieściłem.
ID posta: 390394 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 720 razy
Posty: 3878
Wysłany: 02-08-2020, 13:28   

Kod:
Option Explicit

Private Sub CommandButton1_Click()
Dim i&, p&

i = 1

p = Cells(i, 1).Value

Do Until Cells(i, 1).Value = ""
    If Cells(i + 1, 1).Value <> p + 1 Then
        Cells(i + 1, 1).Interior.Color = vbRed
        i = i + 1
        p = Cells(i, 1).Value
    Else
        Cells(i + 1, 1).Select
        With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
        i = i + 1
        p = Cells(i, 1).Value
    End If
Loop
   
Cells(i, 1).Select
With Selection.Interior
    .Pattern = xlNone
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

End Sub
_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
Chcesz precyzyjną odpowiedź - zadaj precyzyjne pytanie.
ID posta: 390396 Skopiuj do schowka
 
 
Marcindworzan
Stały bywalec Excelforum


Wersja: Win Office 2010
Posty: 308
Wysłany: 02-08-2020, 13:38   

@umiejead - teraz jest super, dziekuje :)
ID posta: 390397 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.marketingNET.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