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: 64396 Skopiuj do schowka Wyszukaj pionowo działające w kilku arkuszach
Autor Wiadomość
kubac
świeżak


Wersja: Win Office 2016
Posty: 2
  Wysłany: 12-03-2019, 09:20   Wyszukaj pionowo działające w kilku arkuszach

Witam,

Potrzebuję pomocy w napisaniu funkcji np. wyszukaj pionowo która na podstawie wyników z kolumny tabeli przestawnej (są to numery salonów które pojawiają się w projekcie) będzie przeszukiwała istniejące arkusze w pliku np komórki C4 (w każdym arkuszu w tej komórce wpisany jest numer salonu) i sprawdzała czy dany numer gdzieś już się pojawił.

Mówiąc prościej np. wieloarkuszowa funkcja wyszukaj pionowo.

Najfajniej by było jak by jakieś makro wyszukjąc nowy numer z tabeli przestawnej tworzyło mi nowy arkusz wraz z tabelką ale to już za dużo proszę. Muszę podszkolić się w dziedzinie VBA.

W załączniku przesyłam plik przykładowy. Prosze o pomoc bądź nakierowanie w jaki sposób napisać taką funkcję.

Pozdrawiam.

Przyklad Wyszukaj.xlsx
Pobierz Plik ściągnięto 10 raz(y) 16.59 KB

ID posta: 363988 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Pomógł: 252 razy
Posty: 1372
Wysłany: 12-03-2019, 11:49   

Cytat:
Najfajniej by było jak by jakieś makro wyszukjąc nowy numer z tabeli przestawnej tworzyło mi nowy arkusz wraz z tabelką
Nie ma problemu tyle, że w tych poszczególnych arkuszach masz dane z innych plików - więc kod tworzy arkusz z pustą tabelką.
Kod:
Option Explicit

Private Sub CommandButton1_Click()
Dim wsTb As Worksheet, ws As Worksheet, ark As String
Dim i As Long, d As Long, jest As Boolean

On Error GoTo laEnd

Set wsTb = Sheets("Tabela")

d = wsTb.Cells(Rows.Count, "A").End(xlUp).Row - 2

For i = 4 To d
    jest = True
    ark = wsTb.Cells(i, 1).Value
   
    For Each ws In ActiveWorkbook.Sheets
        If ws.Name <> ark Then
            jest = False
        Else
            jest = True
            Exit For
        End If
    Next ws
   
    If jest = False Then
        Sheets("Wzor").Copy After:=Worksheets(Sheets.Count)
        ActiveSheet.Name = ark
    End If
   
Next i
Exit Sub

laEnd:
MsgBox "Błąd: " & Err.Number & vbCrLf & vbCrLf & ark & " - " & Err.Description, vbCritical, "UWAGA!"

End Sub

(Nie usuwaj arkusza "Wzor").

INFO: jeśli usuniesz wartość z "Tabeli" - kod nie usunie arkusza z tą nazwą.

Kopia Przyklad Wyszukaj-2.xlsm
Pobierz Plik ściągnięto 4 raz(y) 43.83 KB

_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
I dbajmy - proszę - o poprawną polszczyznę.
  
ID posta: 364005 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