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: 75349 Skopiuj do schowka Skanowanie kodów kreskowych - prośba o modyfikacje
Autor Wiadomość
nina1 
Exceloholic


Wersja: Win Office 2016
Posty: 110
Wysłany: 10-12-2023, 14:33   Skanowanie kodów kreskowych - prośba o modyfikacje

Witam, dzięki uprzejmości Tajan, który poprawił mi kod do skanowania kodów kreskowych, chciałabym prosić o kolejne modyfikacje, gdyż podczas używania pliku pojawiło się kilka problemów.
Pierwszy problem dotyczy dodania w arkuszu "baza" kolejnego wiersza, gdyż kliknięcie 1 raz w przycisk "aktualizuj z bazy" wkleja dane, a kliknięcie drugi raz dopiero dodaje dane do kolumny "Z", a chciałabym, aby wszystko dodało po pierwszym kliknięciu.
Drugi problem dotyczy odwrotności, czyli usunięcia z bazy całego wiersza,
wtedy po kliknięciu "aktualizuj z bazy" usuwa w arkuszu "skan" tylko dane do kolumny "U", natomiast dane w "Y" i "Z" zostają, a też chciałabym, aby zostały usunięte.
Kolejny problem, to próba zeskanowania skanerem kodu, gdy omyłkowo jestem w innej komórce - brak jakiejkolwiek reakcji (nie wyskakuje komunikat o zablokowanej komórce), jeśli tego nie zauważę, to nie wiem, że nic się nie skanuje i nie pokazuje mi poprawnych danych. Da radę jakoś to naprawić w taki sposób, że jeśli omyłkowo jestem w innej komórce niż B3 lub B20, to aby przy próbie zeskanowania kodu wyskakiwał komunikat typu "przejdź do komórki B3" lub może jakoś automatycznie przeniesie do B3 jeśli jestem w innej komórce, a następnie wczyta zeskanowany wcześniej kod ?

wzor_skan(tj)(1).xlsm
Pobierz Plik ściągnięto 19 raz(y) 47.33 KB

ID posta: 432057 Skopiuj do schowka
 
 
Tajan


Pomógł: 5407 razy
Posty: 11795
Wysłany: 10-12-2023, 16:16   

Zmień procedurę "kopiuj" na następującą:
Kod:
Sub kopiuj()
    Dim wks1 As Worksheet: Set wks1 = Sheets("baza")
    Dim wks2 As Worksheet: Set wks2 = Sheets("skan")
    Dim lastRow As Long: lastRow = wks1.Cells(wks1.Rows.Count, "J").End(xlUp).Row
    Dim rng As Range
    Dim lstR As Long
    Dim i As Long
    Dim cnt As Long

   
    Arkusz1.Unprotect ("x")
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    With wks2
        Set rng = .Range("D4:Z4")
        lstR = .Cells(.Rows.Count, "D").End(xlUp).Row
        If lstR > 3 Then .Range("D4:Z" & lstR).Clear
    End With

    wks1.Range("A2:T" & lastRow).Copy rng.Cells(1, 2)
   
    cnt = lastRow - 1

    wks2.Range("Z4").Resize(cnt).FormulaR1C1 = _
    "=IF(RC[-1]=2,""AWARIA"",IF(RC[-1]=1,""AKTYWNY"",IF(RC[-1]="""",""BRAK"")))"
   
    With rng
        .Cells(1, 1) = 1
        .Cells(1, 1).AutoFill .Cells(1, 1).Resize(cnt), xlFillSeries
        With .Resize(cnt)
            .Font.Size = 8
            With .Borders
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
        End With
    End With
   
    Range("B3").Select
   
    Application.CutCopyMode = False
    Application.EnableEvents = True
    Application.ScreenUpdating = True
   
    Arkusz1.Protect ("x")

End Sub
Natomiast, co do:
nina1 napisał/a:
Kolejny problem, to próba zeskanowania skanerem kodu, gdy omyłkowo jestem w innej komórce
to w opcjach ochrony arkusza usuń zaznaczenie przy "Zaznaczanie zablokowanych komórek". Wtedy, po włączeniu ochrony, nie będzie można zaznaczyć innej komórki niż B3 lub B20.
ID posta: 432059 Skopiuj do schowka
 
 
nina1 
Exceloholic


Wersja: Win Office 2016
Posty: 110
Wysłany: 10-12-2023, 18:32   

ok, ale teraz jak kliknę na "Aktualizuj z bazy" to usuwa mi wszystko co do tej pory zeskanowałam z kolumny Y, a ma usuwać tylko dane usuwanego wiersza, bo inaczej muszę wszystko skanować od nowa
ID posta: 432061 Skopiuj do schowka
 
 
Tajan


Pomógł: 5407 razy
Posty: 11795
Wysłany: 10-12-2023, 19:03   

Ja naprawdę nie wiem jak to ma działać. Wcześniej również wczytywało całą bazę na nowo, tylko nie usuwało danych kolumn Z i Y. Napisałaś, że należy je usuwać, więc tak zrobiłem. O ile dobrze pamiętam wcześniej nie było mowy o dodawaniu czy usuwaniu pojedynczych wierszy.
Jakie ma być zatem działanie przycisku "Aktualizuj z bazy"?
ID posta: 432062 Skopiuj do schowka
 
 
nina1 
Exceloholic


Wersja: Win Office 2016
Posty: 110
Wysłany: 10-12-2023, 21:17   

Powinien kopiować to co jest w arkuszu baza, ale bez usuwania danych z kolumn Y i Z w skan, chyba, że dany wiersz zostanie usunięty z baza, to wtedy usuwa cały wiersz łącznie z danymi z Y i Z, a reszta zostaje bez zmian
ID posta: 432064 Skopiuj do schowka
 
 
Tajan


Pomógł: 5407 razy
Posty: 11795
Wysłany: 10-12-2023, 22:47   

To w takim razie powyższy kod zupełnie się do tego nie nadaje. Trzeba do tego podejść inaczej gdyż należy porównać zawartość bazy z arkuszem skanów i albo usunąć dany wiersz, albo dodać do tabeli skanów. Lecz do tego jest potrzebna wiedza, które pola w bazie i skanach należy ze sobą porównać aby zidentyfikować który wiersz bazy odpowiada dla wiersza w skanach. Czyli chodzi o kolumny w których wartość będzie unikatowa i nie będzie mogła zostać zmieniona. Wg której kolumny ma następować to porównanie?

Edit: W wolnej chwili zmodyfikowałem makro zgodnie z powyższymi założeniami. Do porównania użyłem kolumny "s/n1" czyli "K" w arkuszu "Baza":
Kod:
Sub kopiuj()
    Dim wks1 As Worksheet: Set wks1 = Sheets("baza")
    Dim wks2 As Worksheet: Set wks2 = Sheets("skan")
    Dim lastRow As Long: lastRow = wks1.Cells(wks1.Rows.Count, "J").End(xlUp).Row
    Dim rng As Range
    Dim lstR As Long
    Dim i As Long
    Dim cnt As Long
    Dim scanSN, scanVal, pozSN
   
    Arkusz1.Unprotect ("x")
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    With wks2
        Set rng = .Range("D4:Z4")
        lstR = .Cells(.Rows.Count, "D").End(xlUp).Row
        If lstR > 3 Then
            scanSN = Application.Transpose(.Range("O4:O" & lstR).Value)
            scanVal = Application.Transpose(.Range("Y4:Y" & lstR).Value)
           .Range("D4:Z" & lstR).Clear
        End If
    End With

    wks1.Range("A2:T" & lastRow).Copy rng.Cells(1, 2)
   
    cnt = lastRow - 1

    wks2.Range("Z4").Resize(cnt).FormulaR1C1 = _
    "=IF(RC[-1]=2,""AWARIA"",IF(RC[-1]=1,""AKTYWNY"",IF(RC[-1]="""",""BRAK"")))"
   
    With rng
        .Cells(1, 1) = 1
        .Cells(1, 1).AutoFill .Cells(1, 1).Resize(cnt), xlFillSeries
        With .Resize(cnt)
            .Font.Size = 8
            With .Borders
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            If IsArray(scanSN) Then
               For i = 1 To .Rows.Count
                  pozSN = Application.Match(.Cells(i, 12), scanSN, 0)
                  If Not IsError(pozSN) Then .Cells(i, 22) = scanVal(pozSN)
               Next
            End If
        End With
    End With
   
     
    Range("B3").Select
   
    Application.CutCopyMode = False
    Application.EnableEvents = True
    Application.ScreenUpdating = True
   
    Arkusz1.Protect ("x")

End Sub
ID posta: 432066 Skopiuj do schowka
 
 
nina1 
Exceloholic


Wersja: Win Office 2016
Posty: 110
Wysłany: 11-12-2023, 00:31   

Dziękuję Tajan, teraz działa poprawnie
ID posta: 432071 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