Elektroda.pl
Elektroda.pl
X
Proszę, dodaj wyjątek www.elektroda.pl do Adblock.
Dzięki temu, że oglądasz reklamy, wspierasz portal i użytkowników.

VBA - makro wyszukujące nazwy i kopiujące?

grzana23 06 Wrz 2010 08:13 3998 9
  • #1 06 Wrz 2010 08:13
    grzana23
    Poziom 8  

    Witam wszystkich!Problem jest następującej treści. Potrzebuje aby makro wyszukiwało, zliczało ilość komórek i kopiowało do konkretnej tabeli. Niby nic ale... no właśnie podczas wyszukiwania jest sytuacja,ze dwie wyszukiwane wartości należy zsumować i skopiować. Czyli liczba komórek "brak zapinki" plus "brak woreczka". Próbowałem to nawet zrobić suma jeżeli ale nie dałem rady:/

    Code:

    Sub Makro1()
    '
    ' Makro1 Makro
    ' January
    ' Netherlands
    ' Paprika
        Application.WindowState = xlMinimized
        Sheets("Client Export").Select
        ActiveSheet.Unprotect
        Selection.EntireRow.Hidden = False
        Selection.AutoFilter Field:=1
        Selection.AutoFilter Field:=2
        Selection.AutoFilter Field:=3
        Selection.AutoFilter Field:=4
        Selection.AutoFilter Field:=5
        Selection.AutoFilter Field:=6
        Selection.AutoFilter Field:=7
        Selection.AutoFilter Field:=8
        Selection.AutoFilter Field:=9
        Selection.AutoFilter Field:=10
        Selection.AutoFilter Field:=11
        Selection.AutoFilter Field:=2, Criteria1:="1"
        Selection.AutoFilter Field:=5, Criteria1:="Netherlands"
        Selection.AutoFilter Field:=6, Criteria1:=("Paprika*")

        Sheets("Client Export").Select
        Selection.AutoFilter Field:=10
        Selection.AutoFilter Field:=10, Criteria1:="(O) opakowanie - rozrywa się"
        Range("C3750").Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("NETHERLANDS").Select
        Range("B5").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheets("Client Export").Select
        MsgBox Application.WorksheetFunction.CountIf(Range("C3750"), "(Selection.AutoFilter Field:=10, Criteria1:="(O) brak zapinki")":(Selection.AutoFilter Field:=10, Criteria1:="(O) brak woreczka"))
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("NETHERLANDS").Select
        Range("C5").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Sheets("Client Export").Select
        Selection.AutoFilter Field:=10
        Selection.AutoFilter Field:=10, Criteria1:="(O) nieszczelne opakowanie"
        Range("C3750").Select
        Application.CutCopyMode = False
        Selection.Copy
        Sheets("NETHERLANDS").Select
        Range("F5").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
       
    End Sub

    0 9
  • Pomocny post
    #2 06 Wrz 2010 09:05
    walek33
    Poziom 28  

    Namęczyłeś się z nagraniem tego makra :D, ale czy mógłbyś dla ułatwienia wrzucić przykładowy plik z dokładniejszym opisem co, skąd i dokąd ma być kopiowane?
    A tak na przyszłość prośba. Używaj polskich literek i ubieraj kod w znaczniki Code. Trochę ułatwia czytanie. :D

    0
  • #3 06 Wrz 2010 13:01
    grzana23
    Poziom 8  

    No właśnie zbytnio nie mogę tego pliku zamieścić. Postaram się dobrze opisać problem. Jak widać w kodzie, mam włączone określone kryteria według, których ma wyszukać komórki.
    [code]
    Selection.AutoFilter Field:=2, Criteria1:="1"
    Selection.AutoFilter Field:=5, Criteria1:="Netherlands"
    Selection.AutoFilter Field:=6, Criteria1:=("Paprika*")
    Sheets("Client Export").Select
    Selection.AutoFilter Field:=10
    Selection.AutoFilter Field:=10, Criteria1:="(O) opakowanie - rozrywa się"
    Range("C3750").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("NETHERLANDS").Select
    Range("B5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    I to wszystko działa, problem pojawia się gdy chcę zliczyć ilość komórek z kryterium:
    [code]Selection.AutoFilter Field:=10, Criteria1:="(O) brak zapinki"
    Selection.AutoFilter Field:=10, Criteria1:="(O) brak woreczka"

    gdyż chcę aby w arkuszu "NETHERLANDS" w komórce B5 pojawiła się suma ilości komórek brak zapinki i brak woreczka.

    [/code]Sheets("Client Export").Select
    Selection.AutoFilter Field:=10
    Selection.AutoFilter Field:=10, Criteria1:="(O) brak zapinki"
    Range("C3750").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("NETHERLANDS").Select
    Range("C5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    dodać

    [code]Sheets("Client Export").Select
    Selection.AutoFilter Field:=10
    Selection.AutoFilter Field:=10, Criteria1:="(O) brak woreczka"
    Range("C3750").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("NETHERLANDS").Select
    Range("C5").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

    znajduje się w C5 :)[/code]

    0
  • #4 06 Wrz 2010 19:43
    adamas_nt
    Moderator Programowanie

    A co wyświetla Ci w tym komunikacie?

    grzana23 napisał:
    MsgBox Application.WorksheetFunction.CountIf(Range("C3750"), "(Selection.AutoFilter Field:=10, Criteria1:="(O) brak zapinki")":(Selection.AutoFilter Field:=10, Criteria1:="(O) brak woreczka"))


    Przychylam się do wniosku kolegów. Bez pliku z przykładem niewiele zdziałamy...

    0
  • #5 07 Wrz 2010 10:02
    walek33
    Poziom 28  

    I nie musi to być plik z Twoimi tajnymi danymi. Chodzi o zasadę działania.

    0
  • #6 07 Wrz 2010 10:39
    grzana23
    Poziom 8  

    Są to dane z czarnych skrzynek TU-154 ;) Dlatego tak niechętnie się nimi dzielę.
    Zamieszczam plik i jedyne makro jakie tam jest dotyczy jednej grupy produktów Braadstomen Paprika w miesiącu January. Jeśli uda się to wam ruszyć (specjalnie nie mówie nam bo moja wiedza się już wyczerpała) to analogiczne polece z innymi produktami i miesiącami.Pozdrawiam i z góry dziękuje za pomoc!!!

    0
  • Pomocny post
    #7 07 Wrz 2010 21:47
    adamas_nt
    Moderator Programowanie

    Czekamy aż zrezygnujesz z prowizji...

    0
  • #8 07 Wrz 2010 22:12
    grzana23
    Poziom 8  

    Dzięki za podpowiedź z tą prowizją!

    0
  • #9 07 Wrz 2010 22:52
    adamas_nt
    Moderator Programowanie

    Makro to wielka zagadka :)

    W zasadzie wszystkie kryteria są w drugim arkuszu.

    Próbowałem tak: W arkuszu "SAMARA NETHERLANDS" w B3 wstawiłem formułę

    Code:
    =SUMA.ILOCZYNÓW(('Client Export'!J:J="(O) woreczek - rozrywa się")*(LEWY('Client Export'!F:F;8)="12083828"))
    Jest to odpowiednik funkcji LICZ.WARUNKI z E2k7. Niestety wiele produktów o różnej nazwie ma kod 12083828.

    Próbowałem od prawej ale w komórkach kolumny F masz wiele znaków powrotu karetki Chr(10), po usunięciu których
    Code:
    Sub Usun_zpk()
    
    For i = 3 To 100
      Cells(i, 6) = Replace(Cells(i, 6), Chr(10), "")
    Next
    End Sub


    VBA - makro wyszukujące nazwy i kopiujące?

    jest szansa...

    VBA - makro wyszukujące nazwy i kopiujące?

    Dodając kryterium dla kolumny A (4 i 5 znak da nam miesiąc) sprawa byłaby rozwiązana.

    0
  • #10 08 Wrz 2010 13:31
    grzana23
    Poziom 8  

    Dzięki za pomysł ale ja zacząłem myśleć o czymś innym.Może po prostu umieścić w SMARA NETHERLANDS gdzieś indziej osobno wyniki dla braku zapinki i brak woreczka, a później swykłą sumą umieścić je w komórce B5.
    Żeby nie było jednak za łatwo, zauważyłem dopiero teraz,że wyszukiwanie poprzez ("Paprika*") nie działa.Pewnie dlatego,że excel szuka w komórce wartości od lewej strony (tak przypuszczam). W innym arkuszu, którego nie dołączyłem szukanie po kryteriach z * działa, fakt jest taki,że wówczas kryterium zaczynało się od słów, które były na początku komórki. Cały czas pod górkę:/

    Dodano po 1 [godziny] 1 [minuty]:

    Znalazłem w necie jeszcze taka małą poradę:
    http://www.lo2.wloclawek.q4.pl/Student/MakrawExcel2.pdf
    Czasami potrzebujemy filtrować/poszukać w wierszu. Brak jest takiego wbudowanego mechanizmu w excelu. Oto makro rozwiązujące ten problem (kod należy wstawić w ARKUSZU, w którym chcemy mieć tą funkcjonalność):

    Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) 'Kliknij wiersz poszukiwań prawym klawiszem myszy
    [/code]If Selection.Rows.Count<>1 Or Selection.Cells.Count=1 Then End
    'Cancel=True
    ciag=InputBox("podaj szukany ciąg.")
    If ciag="" Then End
    Application.ScreenUpdating = False
    With Selection
    Set c = .Find(ciag, LookIn:=xlValues)
    If Not c Is Nothing Then
    pierw_adr = c.Address
    Columns.ColumnWidth = 0.05
    Do
    Range(c.Address).EntireColumn.AutoFit
    Set c = .FindNext(c)
    Loop While Not c Is Nothing And c.Address <> pierw_adr
    End If
    End With
    If c Is Nothing Then MsgBox "Ciąg>> " & ciag & " <<nie występuje!"
    Application.ScreenUpdating = True
    End Sub
    [/code]

    0