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
Zamknięty przez: umiejead
07-04-2021, 00:16
Lista rozwijalna - wielki problem
Autor Wiadomość
Plantator
Starszy Forumowicz


Wersja: Win Office 365
Pomógł: 7 razy
Posty: 38
Wysłany: 05-04-2021, 12:34   

Kod:
Sub Aktualizuj()
Dim el As Variant
Dim i As Byte, k(1 To 5) As Long
Dim col As Byte
Dim poz_nap As Long
Dim poz_data As Variant
Dim MyDate As Long
Dim ilosc As Double
Dim LRow As Long
Dim ShName As Worksheet


    MyDate = Sheets("Raport").Range("C1").Value
    col = Sheets("Baza").ListObjects("Tabela_Napoje").ListColumns.Count - 1

    For Each el In Range("Tabela_Raport[Nazwa napoju]")
        ilosc = el.Offset(, 1).Value / 1000
        poz_nap = Application.Match(el, Range("Tabela_Napoje[Napoje]"), 0) + 2

        For i = 1 To col
            If VBA.Len(Sheets("Baza").Cells(poz_nap, i + 1).Value) > 0 Then
                Set ShName = Sheets(Sheets("Baza").Cells(2, i + 1).Value)
               
                With ShName
                    poz_data = Application.Match(MyDate, .Columns(1), 0)
                    If IsError(poz_data) Then
                        If Len(.Cells(2, 1).Value) = 0 Then
                            .Cells(2, 1).Value = MyDate
                            .Cells(2, 3).Value = ilosc * Sheets("Baza").Cells(poz_nap, i + 1).Value
                            .Cells(2, 2).Value = .Cells(2, 4).Value - .Cells(2, 3).Value
                            k(i) = 1
                        Else
                            LRow = .Cells(1, 1).End(xlDown).Row + 1
                            .Cells(LRow, 1).Value = MyDate
                            .Cells(LRow, 3).Value = ilosc * Sheets("Baza").Cells(poz_nap, i + 1).Value
                            .Cells(LRow, 2).Formula = Application.Sum(.Cells(2, 4).Resize(LRow - 1, 1).Value) - Application.Sum(.Cells(2, 3).Resize(LRow - 1, 1).Value)
                            k(i) = 1
                        End If
                    Else
                        If poz_data = 2 Then
                            If k(i) = 0 Then .Cells(poz_data, 3).Value = 0
                            .Cells(poz_data, 3).Value = ilosc * Sheets("Baza").Cells(poz_nap, i + 1).Value + .Cells(poz_data, 3).Value
                        Else
                            If k(i) = 0 Then .Cells(poz_data, 3).Value = 0
                            .Cells(poz_data, 3).Value = ilosc * Sheets("Baza").Cells(poz_nap, i + 1).Value + .Cells(poz_data, 3).Value
                            .Cells(poz_data, 2).Formula = Application.Sum(.Cells(2, 4).Resize(poz_data - 1, 1).Value) - Application.Sum(.Cells(2, 3).Resize(poz_data - 1, 1).Value)
                        End If
                        k(i) = 1
                    End If
                End With
            End If
        Next i
    Next el

End Sub
ID posta: 403188 Skopiuj do schowka
 
 
kingtlen 
Exceloholic



Pomógł: 1 raz
Posty: 111
Wysłany: 05-04-2021, 13:06   

marecki tak wygląda kod po usunięciu fragmentu o którym pisałeś wcześniej. Może zrobiłem to źle.

Kod:
Sub Aktualizuj()
Dim el As Variant
Dim i As Byte
Dim col As Byte
Dim poz_nap As Long
Dim poz_data As Variant
Dim MyDate As Long
Dim ilosc As Double
Dim LRow As Long
Dim ShName As Worksheet


    MyDate = Sheets("Raport").Range("C1").Value
    col = Sheets("Baza").ListObjects("Tabela_Napoje").ListColumns.Count - 1

    For Each el In Range("Tabela_Raport[Nazwa napoju]")
        ilosc = el.Offset(, 1).Value / 1000
        poz_nap = Application.Match(el, Range("Tabela_Napoje[Napoje]"), 0) + 2

        For i = 1 To col
            If VBA.Len(Sheets("Baza").Cells(poz_nap, i + 1).Value) > 0 Then
                Set ShName = Sheets(Sheets("Baza").Cells(2, i + 1).Value)
               
                With ShName
                    poz_data = Application.Match(MyDate, .Columns(1), 0)
                    If IsError(poz_data) Then
                        If Len(.Cells(2, 1).Value) = 0 Then
                            .Cells(2, 1).Value = CDate(MyDate)
                            .Cells(2, 3).Value = ilosc * Sheets("Baza").Cells(poz_nap, i + 1).Value
                            .Cells(2, 2).Value = .Cells(2, 4).Value - .Cells(2, 3).Value
                        Else
                            LRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
                            .Cells(LRow, 1).Value = CDate(MyDate)
                            .Cells(LRow, 2).Formula = Application.Sum(.Cells(2, 4).Resize(LRow - 1, 1).Value) - Application.Sum(.Cells(2, 3).Resize(LRow - 1, 1).Value)
                            .Cells(LRow, 3).Value = ilosc * Sheets("Baza").Cells(poz_nap, i + 1).Value
                        End If
                    Else
                        If poz_data = 2 Then
                            .Cells(poz_data, 3).Value = ilosc * Sheets("Baza").Cells(poz_nap, i + 1).Value
                        Else
                            .Cells(poz_data, 3).Value = ilosc * Sheets("Baza").Cells(poz_nap, i + 1).Value
                            .Cells(poz_data, 2).Value = Application.Sum(.Cells(2, 4).Resize(poz_data - 1, 1).Value) - Application.Sum(.Cells(2, 3).Resize(poz_data - 1, 1).Value)
                        End If
                    End If
                End With
            End If
        Next i
    Next el

End Sub
  
ID posta: 403189 Skopiuj do schowka
 
 
kingtlen 
Exceloholic



Pomógł: 1 raz
Posty: 111
Wysłany: 05-04-2021, 18:58   

Plantator napisał/a:
Kod:
Sub Aktualizuj()
Dim el As Variant
Dim i As Byte, k(1 To 5) As Long
Dim col As Byte
Dim poz_nap As Long
Dim poz_data As Variant
Dim MyDate As Long
Dim ilosc As Double
Dim LRow As Long
Dim ShName As Worksheet


    MyDate = Sheets("Raport").Range("C1").Value
    col = Sheets("Baza").ListObjects("Tabela_Napoje").ListColumns.Count - 1

    For Each el In Range("Tabela_Raport[Nazwa napoju]")
        ilosc = el.Offset(, 1).Value / 1000
        poz_nap = Application.Match(el, Range("Tabela_Napoje[Napoje]"), 0) + 2

        For i = 1 To col
            If VBA.Len(Sheets("Baza").Cells(poz_nap, i + 1).Value) > 0 Then
                Set ShName = Sheets(Sheets("Baza").Cells(2, i + 1).Value)
               
                With ShName
                    poz_data = Application.Match(MyDate, .Columns(1), 0)
                    If IsError(poz_data) Then
                        If Len(.Cells(2, 1).Value) = 0 Then
                            .Cells(2, 1).Value = MyDate
                            .Cells(2, 3).Value = ilosc * Sheets("Baza").Cells(poz_nap, i + 1).Value
                            .Cells(2, 2).Value = .Cells(2, 4).Value - .Cells(2, 3).Value
                            k(i) = 1
                        Else
                            LRow = .Cells(1, 1).End(xlDown).Row + 1
                            .Cells(LRow, 1).Value = MyDate
                            .Cells(LRow, 3).Value = ilosc * Sheets("Baza").Cells(poz_nap, i + 1).Value
                            .Cells(LRow, 2).Formula = Application.Sum(.Cells(2, 4).Resize(LRow - 1, 1).Value) - Application.Sum(.Cells(2, 3).Resize(LRow - 1, 1).Value)
                            k(i) = 1
                        End If
                    Else
                        If poz_data = 2 Then
                            If k(i) = 0 Then .Cells(poz_data, 3).Value = 0
                            .Cells(poz_data, 3).Value = ilosc * Sheets("Baza").Cells(poz_nap, i + 1).Value + .Cells(poz_data, 3).Value
                        Else
                            If k(i) = 0 Then .Cells(poz_data, 3).Value = 0
                            .Cells(poz_data, 3).Value = ilosc * Sheets("Baza").Cells(poz_nap, i + 1).Value + .Cells(poz_data, 3).Value
                            .Cells(poz_data, 2).Formula = Application.Sum(.Cells(2, 4).Resize(poz_data - 1, 1).Value) - Application.Sum(.Cells(2, 3).Resize(poz_data - 1, 1).Value)
                        End If
                        k(i) = 1
                    End If
                End With
            End If
        Next i
    Next el

End Sub


Kod wydaje się działać właściwie ale gdy rozbudowałem arkusz o kolejne produkty pojawia się Run time error i podświetla się na żółto If k(i) = 0 Then
ID posta: 403200 Skopiuj do schowka
 
 
Plantator
Starszy Forumowicz


Wersja: Win Office 365
Pomógł: 7 razy
Posty: 38
Wysłany: 05-04-2021, 20:36   

To raczej nie kwestia kolejnych produktów tylko większej ilości składników.
Zmień deklaracje zmiennej k i dodaj instrukcje ReDim
Kod:
Dim el As Variant
Dim i As Byte, k() As Long
Dim col As Byte
Dim poz_nap As Long
Dim poz_data As Variant
Dim MyDate As Long
Dim ilosc As Double
Dim LRow As Long
Dim ShName As Worksheet


    MyDate = Sheets("Raport").Range("C1").Value
    col = Sheets("Baza").ListObjects("Tabela_Napoje").ListColumns.Count - 1
    ReDim k(1 To col)
ID posta: 403204 Skopiuj do schowka
 
 
kingtlen 
Exceloholic



Pomógł: 1 raz
Posty: 111
Wysłany: 05-04-2021, 22:19   

Plantator napisał/a:
To raczej nie kwestia kolejnych produktów tylko większej ilości składników.
Zmień deklaracje zmiennej k i dodaj instrukcje ReDim
Kod:
Dim el As Variant
Dim i As Byte, k() As Long
Dim col As Byte
Dim poz_nap As Long
Dim poz_data As Variant
Dim MyDate As Long
Dim ilosc As Double
Dim LRow As Long
Dim ShName As Worksheet


    MyDate = Sheets("Raport").Range("C1").Value
    col = Sheets("Baza").ListObjects("Tabela_Napoje").ListColumns.Count - 1
    ReDim k(1 To col)


Zrobiłem jak pisałeś ale teraz makro zwraca błąd w innym miejscu. W załączniku mam teraz plik o bardzo dużej liczbie produktów i materiałów. Nie uzupełniłem tylko wszystkich arkuszy z materiałami (dałem ich chyba 10) ale z tym sobie poradzę. Gdybyś mógł zerknąć

Rozliczenie inny kod — kopia.xlsm
Pobierz Plik ściągnięto 5 raz(y) 116.1 KB

  
ID posta: 403209 Skopiuj do schowka
 
 
Plantator
Starszy Forumowicz


Wersja: Win Office 365
Pomógł: 7 razy
Posty: 38
Wysłany: 06-04-2021, 08:14   

Każdy materiał w Tabela_Napoje musi mieć arkusz o dokładnie takiej samej nazwie.
Wyrzuca błąd ponieważ nie znajduje arkusza o nazwie Materiał 11.
ID posta: 403217 Skopiuj do schowka
 
 
kingtlen 
Exceloholic



Pomógł: 1 raz
Posty: 111
Wysłany: 06-04-2021, 08:39   

Plantator teraz mam dla każdego materiału arkusz i nadal jest problem z makro. Problem się pojawił w momencie gdy chciałem by makro działało tylko raz bez dodawania kolejnych wartości. Czyli jeśli wpiszę ilość produktu np. 500 kg i zrobię aktualizuj to chce mieć możliwość poprawy tej ilości i ponownego zaktualizowania dla ostatniej ilości wpisanej w arkuszu raport. Chcę mieć również możliwość dodania większej ilości materiałów i produktów.

Rozliczenie inny kod — kopia.xlsm
Pobierz Plik ściągnięto 7 raz(y) 44.71 KB

  
ID posta: 403219 Skopiuj do schowka
 
 
Plantator
Starszy Forumowicz


Wersja: Win Office 365
Pomógł: 7 razy
Posty: 38
Wysłany: 06-04-2021, 09:00   

Tak jak pisałem, arkusz musi mieć dokładnie taką samą nazwę jak materiał. Jest literówka w nazwie materiału.
ID posta: 403221 Skopiuj do schowka
 
 
kingtlen 
Exceloholic



Pomógł: 1 raz
Posty: 111
Wysłany: 06-04-2021, 20:40   

Plantator tak miałeś rację była literówka nie dojrzałem. Powoli dochodzę do ładu z tym plikiem
ID posta: 403259 Skopiuj do schowka
 
 
Wyświetl posty z ostatnich:   
Ten temat jest zablokowany bez możliwości zmiany postów lub pisania odpowiedzi
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