logo elektroda
logo elektroda
X
logo elektroda
Szukanie Zaawansowane
logo elektroda
REKLAMA
REKLAMA
Adblock/uBlockOrigin/AdGuard mogą powodować znikanie niektórych postów z powodu nowej reguły.

Optymalizacja kodu VBA w Excelu do szybszego generowania raportów - praca na dużych danych

gta5radek90211 07 Paź 2023 11:29 897 22
REKLAMA
Zgłoś naruszenie prawa
Odpowiedz | Nowy temat
  • #1 20761465
    gta5radek90211
    Poziom 3  
    Posty: 8
    Ocena: 1
    Witajcie,
    Zwracam się do Was z prośbą o pomoc.
    W pracy otrzymuję raport, który niestety nie jest do końca "przyjazny" do późniejszej obróbki, więc musiałem stworzyć kod, żeby to ogarnął.
    Kod działa, ale jego działanie trwa bardzo długo... Czasami trwa 30-40 min, bo tyle jest tych danych, a komputer pracuje jak odrzutowiec... :(
    W załączniku przykład z losowymi wartościami.
    Bardzo proszę o wsparcie w przyspieszeniu generowania/przerabiania raportu. :)

    Elektro...zip (22.43 kB)Musisz być zalogowany, aby pobrać ten załącznik.

    Mam to:
    Arkusz kalkulacyjny z danymi liczbowymi w wierszach i kolumnach.

    Chciałbym uzyskać to:
    Tabela w arkuszu kalkulacyjnym z literami i liczbami.


    Mój kod to:
    Kod: text Rozwiń Zaznacz wszystko Kopiuj do schowka
    Sub Dzielenie_numerów_zamówień()
'
' Makro3 Makro
'

'



Application.ScreenUpdating = False




'Application.ScreenUpdating = False


poczatek: Range("F1").Select
Range("F1").Select

    Selection.End(xlDown).Select
    
    
    
    
If ActiveCell <> "" Then
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 0).Range("A1:C1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 5).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -1).Range("A1").Select
    ActiveSheet.Paste
    
    
                    ActiveCell.Offset(-1, 32).Range("A1").Select
                    
                    If ActiveCell <> "" Then
                    
                    Selection.Cut
                    ActiveCell.Offset(1, -1).Range("A1").Select
                    ActiveSheet.Paste
    
    Else
    ActiveCell.Offset(1, -1).Range("A1").Select
    
    
    End If
Else:


'Koniec_pracy
    Range("A1").Select
    Application.ScreenUpdating = True
    GoTo Koniec
    
    
    End If
    
    
    
    '2
    
    ActiveCell.Offset(-1, -29).Range("A1").Select
If ActiveCell <> "" Then
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 0).Range("A1:C1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 6).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -2).Range("A1").Select
    ActiveSheet.Paste
    

    
    
                    ActiveCell.Offset(-1, 33).Range("A1").Select
                    If ActiveCell <> "" Then
                    
                Selection.Cut
                ActiveCell.Offset(1, -2).Range("A1").Select
                ActiveSheet.Paste
                
                    Else
    ActiveCell.Offset(1, -2).Range("A1").Select
    
     End If
    
    
    Else:
    GoTo poczatek
    
    End If
    
    
    
    '3
    
    
    
        ActiveCell.Offset(-1, -28).Range("A1").Select
If ActiveCell <> "" Then
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 0).Range("A1:C1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 7).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -3).Range("A1").Select
    ActiveSheet.Paste
    
                     ActiveCell.Offset(-1, 34).Range("A1").Select
                    If ActiveCell <> "" Then
                    
                    Selection.Cut
                    ActiveCell.Offset(1, -3).Range("A1").Select
                    ActiveSheet.Paste
                    
                    
    Else
    ActiveCell.Offset(1, -3).Range("A1").Select
                    
                    End If
    
    Else:
    GoTo poczatek
        
    End If
    
    
    
    
    
    '4
    
    
    
            ActiveCell.Offset(-1, -27).Range("A1").Select
If ActiveCell <> "" Then
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 0).Range("A1:C1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 8).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -4).Range("A1").Select
    ActiveSheet.Paste
    
    
                        ActiveCell.Offset(-1, 35).Range("A1").Select
                    If ActiveCell <> "" Then
                        
                    Selection.Cut
                    ActiveCell.Offset(1, -4).Range("A1").Select
                    ActiveSheet.Paste
                    
                    
                        Else
                        ActiveCell.Offset(1, -4).Range("A1").Select
                    End If
    Else:
    GoTo poczatek
    
    End If
    
    
    
    
    
    '5
    
            ActiveCell.Offset(-1, -26).Range("A1").Select
If ActiveCell <> "" Then
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 0).Range("A1:C1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 9).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -5).Range("A1").Select
    ActiveSheet.Paste
    
    
                        ActiveCell.Offset(-1, 36).Range("A1").Select
                    If ActiveCell <> "" Then
                            
                    Selection.Cut
                    ActiveCell.Offset(1, -5).Range("A1").Select
                    ActiveSheet.Paste
                    
    
    
                            Else
                        ActiveCell.Offset(1, -5).Range("A1").Select
                        End If
    Else:
    GoTo poczatek
    
    End If
    
    
    
    
    '6
    
    
    
            ActiveCell.Offset(-1, -25).Range("A1").Select
If ActiveCell <> "" Then
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 0).Range("A1:C1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 10).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -6).Range("A1").Select
    ActiveSheet.Paste
    
                            ActiveCell.Offset(-1, 37).Range("A1").Select
                If ActiveCell <> "" Then

                Selection.Cut
                ActiveCell.Offset(1, -6).Range("A1").Select
                ActiveSheet.Paste
                'End If
    
                            Else
                        ActiveCell.Offset(1, -6).Range("A1").Select
                        End If
    Else:
    GoTo poczatek
    
    End If
    
    
    
                ActiveCell.Offset(-1, -24).Range("A1").Select
If ActiveCell <> "" Then
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 0).Range("A1:C1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 11).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -7).Range("A1").Select
    ActiveSheet.Paste
    
                                  ActiveCell.Offset(-1, 38).Range("A1").Select
                If ActiveCell <> "" Then

                Selection.Cut
                ActiveCell.Offset(1, -7).Range("A1").Select
                ActiveSheet.Paste
                'End If
                
                            Else
                        ActiveCell.Offset(1, -7).Range("A1").Select
                        End If
    Else:
    GoTo poczatek
    
    End If
    
    
                ActiveCell.Offset(-1, -23).Range("A1").Select
If ActiveCell <> "" Then
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 0).Range("A1:C1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 12).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -8).Range("A1").Select
    ActiveSheet.Paste
    
                                 ActiveCell.Offset(-1, 39).Range("A1").Select
                If ActiveCell <> "" Then

                Selection.Cut
                ActiveCell.Offset(1, -8).Range("A1").Select
                ActiveSheet.Paste
                'End If
                    
                            Else
                            ActiveCell.Offset(1, -8).Range("A1").Select
                        End If
    Else:
    GoTo poczatek
    
    End If
    
    
                ActiveCell.Offset(-1, -22).Range("A1").Select
If ActiveCell <> "" Then
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 0).Range("A1:C1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 13).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -9).Range("A1").Select
    ActiveSheet.Paste
    
                                ActiveCell.Offset(-1, 40).Range("A1").Select
                If ActiveCell <> "" Then

                Selection.Cut
                ActiveCell.Offset(1, -9).Range("A1").Select
                ActiveSheet.Paste
                'End If
                    
                            Else
                        ActiveCell.Offset(1, -9).Range("A1").Select
                        End If
    Else:
    GoTo poczatek
    
    End If
    
    
    
                    ActiveCell.Offset(-1, -21).Range("A1").Select
If ActiveCell <> "" Then
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 0).Range("A1:C1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 14).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -10).Range("A1").Select
    ActiveSheet.Paste
    
                                ActiveCell.Offset(-1, 41).Range("A1").Select
                If ActiveCell <> "" Then

                Selection.Cut
                ActiveCell.Offset(1, -10).Range("A1").Select
                ActiveSheet.Paste
                'End If
    
                    
                            Else
                        ActiveCell.Offset(1, -10).Range("A1").Select
                        End If
    Else:
    GoTo poczatek
    
    End If
    
    
    
                    ActiveCell.Offset(-1, -20).Range("A1").Select
If ActiveCell <> "" Then
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 0).Range("A1:C1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 15).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -11).Range("A1").Select
    ActiveSheet.Paste
    
    
                                 ActiveCell.Offset(-1, 42).Range("A1").Select
                If ActiveCell <> "" Then

                Selection.Cut
                ActiveCell.Offset(1, -11).Range("A1").Select
                ActiveSheet.Paste
               ' End If
    
                    
                            Else
                        ActiveCell.Offset(1, -11).Range("A1").Select
                        End If
    Else:
    GoTo poczatek
    
    End If
    
    
    
                    ActiveCell.Offset(-1, -19).Range("A1").Select
If ActiveCell <> "" Then
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 0).Range("A1:C1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 16).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -12).Range("A1").Select
    ActiveSheet.Paste
    
                                 ActiveCell.Offset(-1, 43).Range("A1").Select
                If ActiveCell <> "" Then

                Selection.Cut
                ActiveCell.Offset(1, -12).Range("A1").Select
                ActiveSheet.Paste
                'End If
                    
                            Else
                        ActiveCell.Offset(1, -12).Range("A1").Select
                        End If
    Else:
    GoTo poczatek
    
    End If
    
                    ActiveCell.Offset(-1, -18).Range("A1").Select
If ActiveCell <> "" Then
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 0).Range("A1:C1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 17).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -13).Range("A1").Select
    ActiveSheet.Paste
    
                                ActiveCell.Offset(-1, 44).Range("A1").Select
                If ActiveCell <> "" Then

                Selection.Cut
                ActiveCell.Offset(1, -13).Range("A1").Select
                ActiveSheet.Paste
                'End If
    
                    
                            Else
                        ActiveCell.Offset(1, -13).Range("A1").Select
                        End If
    Else:
    GoTo poczatek
    
    End If
    
    
    
                        ActiveCell.Offset(-1, -17).Range("A1").Select
If ActiveCell <> "" Then
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 0).Range("A1:C1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 18).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -14).Range("A1").Select
    ActiveSheet.Paste
                
                                 ActiveCell.Offset(-1, 45).Range("A1").Select
                If ActiveCell <> "" Then

                Selection.Cut
                ActiveCell.Offset(1, -14).Range("A1").Select
                ActiveSheet.Paste
                'End If
                    
                            Else
                        ActiveCell.Offset(1, -14).Range("A1").Select
                        End If
    Else:
    GoTo poczatek
    
    End If
    
    
        ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    
                        ActiveCell.Offset(-1, -16).Range("A1").Select
If ActiveCell <> "" Then
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 0).Range("A1:C1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 19).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -15).Range("A1").Select
    ActiveSheet.Paste
    
    
                                ActiveCell.Offset(-1, 46).Range("A1").Select
                If ActiveCell <> "" Then

                Selection.Cut
                ActiveCell.Offset(1, -15).Range("A1").Select
                ActiveSheet.Paste
               ' End If
                    
                            Else
                        ActiveCell.Offset(1, -15).Range("A1").Select
                        End If
    Else:
    GoTo poczatek
        End If
    
    
                        ActiveCell.Offset(-1, -15).Range("A1").Select
If ActiveCell <> "" Then
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 0).Range("A1:C1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 20).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -16).Range("A1").Select
    ActiveSheet.Paste
    
                                 ActiveCell.Offset(-1, 47).Range("A1").Select
                If ActiveCell <> "" Then

                Selection.Cut
                ActiveCell.Offset(1, -16).Range("A1").Select
                ActiveSheet.Paste
                'End If
    
                    
                            Else
                        ActiveCell.Offset(1, -16).Range("A1").Select
                        End If
    Else:
    GoTo poczatek
        End If
    
    
                        ActiveCell.Offset(-1, -14).Range("A1").Select
If ActiveCell <> "" Then
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 0).Range("A1:C1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 21).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -17).Range("A1").Select
    ActiveSheet.Paste
    
                                 ActiveCell.Offset(-1, 48).Range("A1").Select
                If ActiveCell <> "" Then

                Selection.Cut
                ActiveCell.Offset(1, -17).Range("A1").Select
                ActiveSheet.Paste
               ' End If
   
                    
                            Else
                        ActiveCell.Offset(1, -17).Range("A1").Select
                        End If
    Else:
    GoTo poczatek
        End If
    
                        ActiveCell.Offset(-1, -13).Range("A1").Select
If ActiveCell <> "" Then
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 0).Range("A1:C1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 22).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -18).Range("A1").Select
    ActiveSheet.Paste
    
                                ActiveCell.Offset(-1, 49).Range("A1").Select
                If ActiveCell <> "" Then

                Selection.Cut
                ActiveCell.Offset(1, -18).Range("A1").Select
                ActiveSheet.Paste
                'End If
    
                    
                            Else
                        ActiveCell.Offset(1, -18).Range("A1").Select
                        End If
    Else:
    GoTo poczatek
        End If
    
    
                        ActiveCell.Offset(-1, -12).Range("A1").Select
If ActiveCell <> "" Then
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 0).Range("A1:C1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 23).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -19).Range("A1").Select
    ActiveSheet.Paste
    
                                ActiveCell.Offset(-1, 50).Range("A1").Select
                If ActiveCell <> "" Then

                Selection.Cut
                ActiveCell.Offset(1, -19).Range("A1").Select
                ActiveSheet.Paste
                'End If
                    
                            Else
                        ActiveCell.Offset(1, -19).Range("A1").Select
                        End If
    Else:
    GoTo poczatek
        End If
    
    
                        ActiveCell.Offset(-1, -11).Range("A1").Select
If ActiveCell <> "" Then
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 0).Range("A1:C1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 24).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -20).Range("A1").Select
    ActiveSheet.Paste
    
                                ActiveCell.Offset(-1, 51).Range("A1").Select
                If ActiveCell <> "" Then

                Selection.Cut
                ActiveCell.Offset(1, -20).Range("A1").Select
                ActiveSheet.Paste
                'End If
                    
                            Else
                        ActiveCell.Offset(1, -20).Range("A1").Select
                        End If
    Else:
    GoTo poczatek
        End If
    
    
    
    
    
    
    
                        ActiveCell.Offset(-1, -10).Range("A1").Select
If ActiveCell <> "" Then
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 0).Range("A1:C1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 25).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -21).Range("A1").Select
    ActiveSheet.Paste
    
                                ActiveCell.Offset(-1, 52).Range("A1").Select
                If ActiveCell <> "" Then

                Selection.Cut
                ActiveCell.Offset(1, -21).Range("A1").Select
                ActiveSheet.Paste
                'End If
                    
                            Else
                        ActiveCell.Offset(1, -21).Range("A1").Select
                        End If
    Else:
    GoTo poczatek
    
End If
    
    
    
    
    
    
    
    
                            ActiveCell.Offset(-1, -9).Range("A1").Select
If ActiveCell <> "" Then
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    ActiveCell.Offset(-1, 0).Range("A1:C1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-1, 25).Range("A1").Select
    Selection.Cut
    ActiveCell.Offset(1, -21).Range("A1").Select
    ActiveSheet.Paste
    
                                ActiveCell.Offset(-1, 52).Range("A1").Select
                If ActiveCell <> "" Then

                Selection.Cut
                ActiveCell.Offset(1, -22).Range("A1").Select
                ActiveSheet.Paste
                'End If
                    
                            Else
                        ActiveCell.Offset(1, -22).Range("A1").Select
                        End If
    Else:
    GoTo poczatek
    
End If
    
    
    
    
    GoTo poczatek
    
    
    
Koniec:
    Exit Sub
    



Application.ScreenUpdating = True
    

End Sub
  • REKLAMA
  • #2 20761579
    Dżyszla
    Poziom 42  
    Posty: 7077
    Pomógł: 1095
    Ocena: 226
    Przede wszystkim nie używaj kopiowania/wycinania i wklejania, tylko przepisuj wartości, jak potrzebujesz.

    A ogólnie - możesz opisać słownie algorytm? Analiza całości trochę czasochłonna. Co tam tyle formatowania? co, poza samym przekształceniem tablicy dwuwymiarowej w jednowymiarową z uzupełnionym kluczem jeszcze potrzebujesz? Czy klucz zawsze w kolumnie B, a wartości zaczynają się od E, czy to może być różnie?
  • #3 20761770
    gta5radek90211
    Poziom 3  
    Posty: 8
    Ocena: 1
    Dzięki za odpowiedź,
    Chodzi o to, by finalnie wszystkie wartości (Kolumna E) można było łatwo filtrować dla konkretnych przypisanych do nich danych (kolumna B)

    Na przykład potrzebuję listy wartości (Kolumna E) jakie są przypisane dla litery ,,b".
    Jeżeli jest poziomo, to nie mogę (w dalszych etapach swojej pracy) filtrować litery ,,b", a gdy jest wszystko pionowo w dwóch kolumnach, to nie ma problemu.

    W dalszych etapach swojej pracy uzyskuję wartości (Kolumna E) na przykład dla litery ,,b" używając filtrowania.

    Kolumna B i E w arkuszu Excel z różnymi wartościami do filtrowania.

    Najważniejsze jest dla mnie łatwość filtrowania danych po pracy algorytmu.
    Program służy mi w dalszych etapach pracy do automatycznego drukowania klienta (nazwa z kolumny B) oraz jego numerów zamówień (numer z kolumne E).

    Nie jestem ekspertem w Excelu/VBA. Może jest jakiś inny sposób, który jest szybszy oraz łatwiejszy?
    Swój algorytm robiłem używając nagrywania makra, więc może wyglądać słabo.
  • Pomocny post
    #4 20761889
    Dżyszla
    Poziom 42  
    Posty: 7077
    Pomógł: 1095
    Ocena: 226
    No ale jak chcesz filtrować po kontrahencie, to masz aktualnie wszystkie numery w kolejnych kolumnach... W czymś to przeszkadza? Czy może problem jest jakiś inny, bo dla opisanego przypadku to nie bardzo widzę sens robienia tego, co robisz...

    Niemniej - na pewno dla czytelności i ograniczenia ilości kodu lepiej by było posłużyć się pętlami i, jak podałem, wprost przepisywać wartości.

    ---

    Tak na szybko (przy czym, dla wygody, przyjmuję, że kontrahent jest w A, a dane zaczynają się od B i transponowanie zaczyna się od 10. wiersza):

    Kod: VBScript
    Zaloguj się, aby zobaczyć kod
  • REKLAMA
  • #5 20762275
    ex-or
    Poziom 28  
    Posty: 785
    Pomógł: 147
    Ocena: 151
    Kojarzy mi się że taki ficzer jest w PowerQuery.
  • REKLAMA
  • #6 20762426
    PRL
    Poziom 41  
    Posty: 6986
    Pomógł: 953
    Ocena: 922
    Jak dla mnie, to kod jest chaotycznie napisany. Nie uśmiecha mi się go analizować.
    Czy mógłbyś proszę opisać krótko, co chcesz uzyskać?
    I fajnie byłoby, gdyby załączony przykład jakoś ładnie wyglądał. Bez pustych komórek, z nagłówkami kolumn.
    Pozdrawiam.
    Pomogłem? Kup mi kawę.
  • #7 20762540
    Dżyszla
    Poziom 42  
    Posty: 7077
    Pomógł: 1095
    Ocena: 226
    @PRL Bo to było makro bardziej, niż kod. Zaproponowałem koledze bardziej zwięzły i - wydaje mi się - spełniający te założenia, które przedstawił i opisał wcześniej. Coś podejrzewam, że te puste to usunięte dodatkowe dane ;)
  • #8 20762552
    PRL
    Poziom 41  
    Posty: 6986
    Pomógł: 953
    Ocena: 922
    W sumie ten kod jest składnią podobny do arkusza - ... na kółkach. ;)
    Poczekajmy na Autora, może wrzuci uporządkowany arkusz wraz z opisem problemu.
    Pomogłem? Kup mi kawę.
  • #9 20762800
    clubs
    Poziom 38  
    Posty: 2219
    Pomógł: 629
    Ocena: 406
    Kod dla twojego przykładu z post1
    Kod: VBScript
    Zaloguj się, aby zobaczyć kod
    Załączniki:
    • Elektroda2.rar (9.81 KB) Musisz być zalogowany, aby pobrać ten załącznik.
  • #10 20762883
    gta5radek90211
    Poziom 3  
    Posty: 8
    Ocena: 1
    >>20761889
    To jest NIE-SA-MO-WI-TE! Działa!
    Excel/programowanie jest przepotężne.
    Robiłem ten "kod" za pomocą nagrywania makro oraz dodawałem coś od siebie, żeby to działało automatycznie.
    Asem w kodowaniu VBA nie jestem, ale jeżeli mój działał, to działał, a że działał tak sobie, to zwróciłem się o pomoc do (jak widać) odpowiedniej grupy użytkowników. (^_^)

    Próbowałem zmodyfikować pod siebie kod, ale to jest inny LVL.
    Finalnie potrzebuję, by dane (żółte pola - cztery komórki w wierszu kolumnie A-D) podążały razem z numerami zamówień (E, F, G, H, I..., R)
    Koniecznie dane muszą być w takich kolumnach jak jest oznaczone. (kolor niebieski)

    Zrzut ekranu z arkusza kalkulacyjnego Excel z danymi klientów i numerami zamówień w żółtych komórkach.
    Czy jest możliwe, by zrobione pozycje (poziome) zostały usuwane, żeby się nie duplikowały?

    Przykład z wierszem numer 1
    W swoim "kodzie" po prostu kopiowałem A2:D2, tworzyłem niżej nowy wiersz (powstał pusty wiersz), wklejałem, przechodziłem do numeru zamówień, wycinałem E1 (pierwszy numer zamówienia), a następnie wklejałem linijkę niżej w komórkę E3 i tak do końca.

    Zrzut ekranu arkusza kalkulacyjnego pokazujący dane klientów i numery zamówień.
    Załączniki:
    • ElektrodaFin.zip (22.29 KB) Musisz być zalogowany, aby pobrać ten załącznik.
  • #11 20762913
    gta5radek90211
    Poziom 3  
    Posty: 8
    Ocena: 1
    U to mi chodziło!
    Bardzo proszę o zmodyfikowanie, by kopiowało cztery komórki jak opisałem wyżej.
    Dla mnie, to już magia.
    Nagrywanie makr, to przy tym pikuś. D:

    clubs napisał:
    Kod dla twojego przykładu z post1
    Kod: VBScript
    Zaloguj się, aby zobaczyć kod
  • #12 20762957
    Dżyszla
    Poziom 42  
    Posty: 7077
    Pomógł: 1095
    Ocena: 226
    Tam i w moim kodzie, i w kodzie kolegi cały czas operuje się na komórkach adresowanych liczbowo. Po prostu powiel zmieniając odpowiednio wartości indeksów (zmienna, zmienna + 1, zmienna + 2 itd.). Mój masz o tyle czytelniejszy, że w zasadzie na tacy wyłożone, wystarczy skopiować. Kolegi kod za to jest szybszy, bo operuje na całym zakresie od razu i dokonuje transpozycji wartości.

    Zawsze możesz też makro odpalić przy użyciu F8 linia po linii i wówczas możesz zobaczyć, co się dzieje. Jak wyłączysz wyłączanie ScreenUpdating, to będziesz też widział w arkuszu.
  • Pomocny post
    #13 20762975
    clubs
    Poziom 38  
    Posty: 2219
    Pomógł: 629
    Ocena: 406
    Poprawione #10 (dołożyłem instrukcje 'jeżeli' co widać w przykładzie jak numer zam jest tylko 1)
    Kod: VBScript
    Zaloguj się, aby zobaczyć kod
    Załączniki:
    • ElektrodaFin2.rar (15.24 KB) Musisz być zalogowany, aby pobrać ten załącznik.
  • Pomocny post
    #14 20763270
    Prot
    Poziom 38  
    Posty: 2580
    Pomógł: 574
    Ocena: 297
    gta5radek90211 napisał:
    Może jest jakiś inny sposób, który jest szybszy oraz łatwiejszy?

    Moim zdaniem najszybszy i chyba najłatwiejszy sposób uzyskania efektu jak na zrzucie
    Optymalizacja kodu VBA w Excelu do szybszego generowania raportów - praca na dużych danych2023-10...png (12.97 kB)Musisz być zalogowany, aby pobrać ten załącznik.
    to będzie jednak Power Query, który w zasadzie jedną komendą unpivot zrobi całą robotę:
    Kod: VBScript
    Zaloguj się, aby zobaczyć kod


    Całość można przeanalizować w załączonym pliku
    Elektrod...xlsx (19.33 kB)Musisz być zalogowany, aby pobrać ten załącznik.
  • Pomocny post
    #15 20763921
    ex-or
    Poziom 28  
    Posty: 785
    Pomógł: 147
    Ocena: 151
    Prot napisał:
    unpivot


    No właśnie "unpivot", nie pamiętałem tej nazwy. W kreatorze, w wersji polskiej jest to "Anuluj przestawienie kolumn", zakładka "Przekształć":

    Zrzut ekranu przedstawiający interfejs edytora Power Query w programie Excel z tabelą zawierającą dane liczbowe.

    Rezultat:

    Zrzut ekranu z programu Excel, pokazujący Edytor Power Query z tabelą i przestawionymi kolumnami.

    Przekształcenie tabeli z #10 w kreatorze (w różnych wersjach excela batony mogą być inaczej rozmieszczone":
    1. Klik na polu danych
    2. Zakładka "Wstawianie" -> "Tabela" -> klik tyle razy ile trzeba
    3. Zakładka "Dane" -> "Pobieranie i przekształcanie" -> "Z tabeli"
    4. W kreatorze zaznaczyć pierwsze cztery kolumny
    5. Zakładka "Przekształć" -> "Dowolna kolumna" -> "Anuluj przestawienie kolumn" -> "Anuluj przestawienie innych kolumn"
    6. Usunięcie kolumny "Atrybut"
    7. "Zamknij i załaduj"

    Można to zapisać jako szablon (użycie wymaga zachowania tej samej nazwy tabeli i użyci nieco ctrl-c, ctrl-v). Po dodaniu odrobiny VBA wykorzystać do przekształcania plików o dowolnej nazwie.
  • #16 20775529
    JacekCz
    Poziom 42  
    Posty: 8670
    Pomógł: 760
    Ocena: 1464
    Do przechowania danych i ich przetwarzania są bazy danych

    Kropka.
  • #17 20776304
    Dżyszla
    Poziom 42  
    Posty: 7077
    Pomógł: 1095
    Ocena: 226
    @JacekCz
    Co nie zmienia faktu, że jeśli dostajesz dane wejściowe w takiej postaci (a jak zaznaczył autor - właśnie z czymś takim pracuje na wejściu i pewnie nie ma możliwości zmiany tego), to przetworzenie, aby móc wprowadzić to do bazy danych i tak będzie pracą związaną z wykonanym kodem (czy to w excelu, czy PL/SQL, ale wciąż to tylko kod; alternatywa jest właśnie użycie PQ, który jest do takich celów stworzony). Więc uważam, że ten Twój komentarz jest tutaj zupełnie nietrafiony.
  • #18 20776403
    JacekCz
    Poziom 42  
    Posty: 8670
    Pomógł: 760
    Ocena: 1464
    Dżyszla napisał:
    @JacekCz
    Co nie zmienia faktu, że jeśli dostajesz dane wejściowe w takiej postaci (a jak zaznaczył autor - właśnie z czymś takim pracuje na wejściu i pewnie nie ma możliwości zmiany tego),


    Sam, albo ktoś z bliskiego kręgu wybrał pewnie czas temu prowizoryczną technologię zamiast bazy, to "karma wraca".

    Dżyszla napisał:
    @JacekCz
    i tak będzie pracą związaną z wykonanym kodem (czy to w excelu, czy PL/SQL, ale wciąż to tylko kod; alternatywa jest właśnie użycie PQ, który jest do takich celów stworzony). Więc uważam, że ten Twój komentarz jest tutaj zupełnie nietrafiony.



    Żadna moja kwerenda, a tabele w bazach idą w dziesiątki milionów wierszy (5-20mln to codzienność), nie wykonuje mi sie 40 minut. Pierwsza wersja, często z błędem, 10 minut, wyjście do ekspresu, umycie rąk, wyjecie drożdżówki z torebki, talerzyk i pojawiają się wyniki.

    Żadna regularnie eksploatowana nie więcej niż 3-5 minut, a zwykłe codzienne nawet "ciężkie" kwerendy to 40 sek
  • #19 20777841
    PRL
    Poziom 41  
    Posty: 6986
    Pomógł: 953
    Ocena: 922
    @Dżyszla
    Cytat:
    Więc uważam, że ten Twój komentarz jest tutaj zupełnie nietrafiony.


    Też tak uważam.
    Baza danych, to niekoniecznie wielki zbiór danych. Nie mówiąc już o plikach wymiany danych.
    Pomogłem? Kup mi kawę.
  • #20 20782095
    JacekCz
    Poziom 42  
    Posty: 8670
    Pomógł: 760
    Ocena: 1464
    PRL napisał:
    @Dżyszla
    Cytat:
    Więc uważam, że ten Twój komentarz jest tutaj zupełnie nietrafiony.


    Też tak uważam.
    Baza danych, to niekoniecznie wielki zbiór danych. Nie mówiąc już o plikach wymiany danych.


    Jasna, oczywiście, Microsoft na każdej stronie pisze "używajcie VBA do rozwiązań korporacyjnych. Ma fantastyczną bibliotekę standardową, wszystkie znane w algorytmice struktury danych, zawsze dobierze się najbardziej wydajną strukturę do problemu"

    BTW importuję pliki na dziesiątki tysięcy atomowych danych (nie w VBA i z dobrze dobranymi narzędziami) - żaden nie trwa 40 minut. Powyżej 10 już bym miał telefon prezesa.
  • #21 20782299
    PRL
    Poziom 41  
    Posty: 6986
    Pomógł: 953
    Ocena: 922
    Cytat:
    BTW importuję pliki na dziesiątki tysięcy atomowych danych


    A są tacy, którzy importują o wiele mniej. :)
    Pomogłem? Kup mi kawę.
  • REKLAMA
  • #22 20788126
    clubs
    Poziom 38  
    Posty: 2219
    Pomógł: 629
    Ocena: 406
    Kończąc, może temat dostałem info, było
    gta5radek90211 napisał:
    jego działanie trwa bardzo długo... Czasami trwa 30-40 min, bo tyle jest tych danych, a komputer pracuje jak odrzutowiec

    aktualnie (z kodem z postu 13) jest 3-5 min, więc progres jest.
  • #23 20788800
    ex-or
    Poziom 28  
    Posty: 785
    Pomógł: 147
    Ocena: 151
    Kod z #14 zrobił by to zapewne grubo poniżej minuty.
Odpowiedz | Nowy temat
Zgłoś naruszenie prawa

Podsumowanie tematu

LABEL_AI_GENERATED
Użytkownik poszukiwał pomocy w optymalizacji kodu VBA w Excelu, który generował raporty z dużych zbiorów danych, co zajmowało 30-40 minut. W odpowiedziach zasugerowano unikanie kopiowania i wklejania, a zamiast tego przepisywanie wartości oraz użycie pętli w kodzie. Proponowano również wykorzystanie Power Query do przekształcania danych, co mogłoby znacznie przyspieszyć proces. Użytkownik otrzymał kilka przykładów kodu, które poprawiły wydajność do 3-5 minut. Wskazano na możliwość dalszej optymalizacji oraz na znaczenie struktury danych dla efektywności przetwarzania.
Podsumowanie AI na podstawie dyskusji. Może zawierać błędy.
REKLAMA