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: 64412 Skopiuj do schowka Wyciąganie danych z tabeli do edycji i nadpisanie zmian
Autor Wiadomość
mnmarcin79 
Starszy Forumowicz


Posty: 35
Wysłany: 13-03-2019, 11:54   Wyciąganie danych z tabeli do edycji i nadpisanie zmian

Witam,
Potrzebuję od Państwa pomocy w napisaniu makra, które wyciągnie mi z Bazy, dane po wpisaniu jednego warunku w tym przypadku jest to
nr. zlecenia, w Bazie jest to kolumna F
Całe zdarzenie chciałbym aby wykonało się w Arkusz(Edycjazlecenia)
Czyli:
-wyciągnięcie danych z bazy po wpisaniu w komórkę D4 numeru szukanego zlecenia
-możliwość poprawienia kilku pozycji
-nadpisanie dokonanych zmian w zleceniu w bazie


Znalazłem u nas na forum podobny przykład gdzie dane są wyciągane z bazy, link załączam:
przykład

Baza(1).xlsm
Pobierz Plik ściągnięto 14 raz(y) 77.17 KB

ID posta: 364106 Skopiuj do schowka
 
 
kuma 
Excel Expert


Pomógł: 1161 razy
Posty: 3473
Wysłany: 13-03-2019, 14:24   

Przetestuj.
Do modułu normalnego VBA wklej
Kod:
Option Explicit
Public rng As Range

Sub Nadpisz()
    If Not rng Is Nothing Then _
            Sheets("BazaZlecen").Cells(rng.Row, "B").Resize(1, 16).Value = Sheets("Edytujzlecenie").Range("B12:Q12").Value
End Sub


Sub MyFindNext(xvalue As String)
    With Sheets("BazaZlecen")
        Set rng = Sheets("BazaZlecen").Range("F:F").Find(what:=xvalue, _
                                LookIn:=xlValues, _
                                LookAt:=xlWhole, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=True)
    End With
    With Sheets("BazaZlecen")
        If Not rng Is Nothing Then
            Sheets("Edytujzlecenie").Range("B12:Q12").Value = .Cells(rng.Row, "B").Resize(1, 16).Value
        Else
            Sheets("Edytujzlecenie").Range("B12:Q12").ClearContents
        End If
    End With
End Sub
Do modułu arkusza 'Edytujzlecenie' wklej
Kod:
Private Sub CommandButton1_Click()
    Nadpisz
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [D4]) Is Nothing Then Exit Sub
    MyFindNext Target.Value
End Sub
Pozdrawiam.
ID posta: 364119 Skopiuj do schowka
 
 
mnmarcin79 
Starszy Forumowicz


Posty: 35
Wysłany: 13-03-2019, 14:47   

(punkcik)
działa :lol:
Czy można zrobić tak aby przeszukał zakres tabeli i wyciągnął z niej wszystkie pozycje oznaczone numerem zlecenia?
Aktualnie wyciąga tylko jedną i ładnie nadpisuje.
Przykładowo w Tabeli jest kilka pozycji pod tym samym numerem np: 500 są 2 pozycje, kk/500/19 są 3 pozycje.
ID posta: 364121 Skopiuj do schowka
 
 
kuma 
Excel Expert


Pomógł: 1161 razy
Posty: 3473
Wysłany: 13-03-2019, 14:56   

A jak to miałoby być z nadpisywaniem. Które nadpisywać, wszystkie?
Pozdrawiam.
ID posta: 364124 Skopiuj do schowka
 
 
mnmarcin79 
Starszy Forumowicz


Posty: 35
Wysłany: 13-03-2019, 15:01   

Wszystkie pozycje z danego zlecenia żeby się wczytały i była możliwość wszystkich edytowania i nadpisania do bazy.
ID posta: 364125 Skopiuj do schowka
 
 
kuma 
Excel Expert


Pomógł: 1161 razy
Posty: 3473
Wysłany: 13-03-2019, 18:07   

Moduł normalny VBA
Kod:
Option Explicit
Public f_rng As Range

Sub Nadpisz()
    Dim rng As Range, rng2 As Range
    Dim i As Integer, ii As Integer
   
    With Sheets("Edytujzlecenie")
        Set rng2 = .Range("B12:Q" & .Cells(Rows.Count, "D").End(3).Row)
        ii = rng2.Rows.Count
        Set rng = Find_Nr_Zlec(rng2.Cells(1, 5).Value)
        If Not rng Is Nothing Then
            Do
                i = i + 1
                Sheets("BazaZlecen").Cells(rng.Row, "B").Resize(1, 16).Value = rng2.Cells(i, 1).Resize(1, 16).Value
                Set rng = f_rng.FindNext(rng)
            Loop Until i = ii
        End If
        .[D4].ClearContents
        rng2.ClearContents
    End With
    Set rng = Nothing
    Set rng2 = Nothing
    Set f_rng = Nothing
End Sub


Sub FindNext_Nr(xvalue As String)
    Dim rng As Range
    Dim adres As String

    Set rng = Find_Nr_Zlec(xvalue)
    With Sheets("Edytujzlecenie")
        .Range("B11").CurrentRegion.Offset(1, 0).ClearContents
        If Not rng Is Nothing Then
            adres = rng.Address
            Do
                Sheets("Edytujzlecenie").Range("B" & .Cells(Rows.Count, "C").End(3).Row)(2).Resize(1, 16).Value = _
                                                                Sheets("BazaZlecen").Cells(rng.Row, "B").Resize(1, 16).Value
                 Set rng = f_rng.FindNext(rng)
            Loop Until rng Is Nothing Or rng.Address = adres
        End If
    End With
    Set rng = Nothing
End Sub

Private Function Find_Nr_Zlec(xvalue) As Variant
    Set Find_Nr_Zlec = f_rng.Find(what:=xvalue, _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=True)
           
End Function
Moduł arkusza 'Edytujzlecenie'
Kod:
Private Sub CommandButton1_Click()
    Application.EnableEvents = False
    Nadpisz
    Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [D4]) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    Set f_rng = Sheets("BazaZlecen").Range("F:F")
    FindNext_Nr Target.Value
    Application.EnableEvents = True
End Sub
Powinno zadziałać.
Pozdrawiam.
ID posta: 364151 Skopiuj do schowka
 
 
mnmarcin79 
Starszy Forumowicz


Posty: 35
Wysłany: 13-03-2019, 19:35   

i zadziałało:)
punkt
Wasza bezinteresowna pomoc jest niesamowita. Uwielbiam tą stronę i fachowość podejścia do tematów zwykłych użytkowników. :beer
dziękuję
ID posta: 364160 Skopiuj do schowka
 
 
mnmarcin79 
Starszy Forumowicz


Posty: 35
Wysłany: 17-03-2019, 01:54   

Zakładka "Edytujzlecenie" Moduł1
Wywala mi błąd pod koniec makra na tym fragmencie:

Kod:
Private Function Find_Nr_Zlec(xvalue) As Variant
    Set Find_Nr_Zlec = f_rng.Find(what:=xvalue, _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=True)
           
End Function


Mogę prosić o pomoc w rozwiązaniu problemu.

Bazaforum.xlsm
Pobierz Plik ściągnięto 5 raz(y) 37.8 KB

ID posta: 364371 Skopiuj do schowka
 
 
kuma 
Excel Expert


Pomógł: 1161 razy
Posty: 3473
Wysłany: Wczoraj 18:18   

Poprzestawiałeś kolumny do wyszukiwania. Wcześniej 'nr zlecenia' był w kol. F, a teraz masz w kol. D.
Zawsze, najpierw musisz wyszukać po numerze zlecenia, a następnie możesz poprawiać.

Jeśli poprawisz również nr zlecenia to nie zostanie nic nadpisane (program wyszukuje i zapisuje po nr zlecenia - dlatego nie może być zmieniany nr zlecenia).
Zobacz do załącznika.
Pozdrawiam.

Bazaforum_kuma.xlsm
Pobierz Plik ściągnięto 2 raz(y) 39.94 KB

ID posta: 364459 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