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: 70452 Skopiuj do schowka Scalanie tekstu w komórkach wg innej komórki
Autor Wiadomość
mikimike
Forumowicz


Posty: 11
Wysłany: 18-03-2021, 09:19   Scalanie tekstu w komórkach wg innej komórki

Hej.
Mam problem i fajnie jakbyście pomogli znaleźć mi odpowiedź :)
Mianowicie mam excela w stylu:
1. Nr działki (np. 104) 2. Imię i nazwisko właściciela 3. Adres właściciela

I teraz problem - jeśli działka ma więcej niż jednego właściciela to dubluje się wiersz i w kolumnie 2 i 3 podane są dane tych wlascicieli.

Ja potrzebuję dane włąścicieli mieć w jednej komórce jak i adresy. A więc:
1. Nr działki 2. Imoiona i nazwiska wlaściecieli 3. Adresy właścicieli

Co wazne dane i adresy muszę być w formie:
1. Imie i nazwisko
2. Imie i nazwisko
etc

Analogicznie z adresami :)

Trudne?

Przykladowe pliki w zalaczeniu

plik_wzor_wejsciowy.xlsx
Wejsciowy
Pobierz Plik ściągnięto 9 raz(y) 8.14 KB

plik_wzor_wyjsciowy.xlsx
Wyjsciowy
Pobierz Plik ściągnięto 9 raz(y) 8.18 KB

Ostatnio zmieniony przez mikimike 18-03-2021, 09:38, w całości zmieniany 1 raz  
ID posta: 402301 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Wersja: Win Office 2019
Pomógł: 2521 razy
Posty: 8407
Wysłany: 18-03-2021, 10:23   

Proszę taki kod:
Kod:
Option Explicit

Sub Test()
Dim lRow As Long
Dim i As Long
Dim x As Long
Dim z As Long
Dim vArr_in As Variant
Dim vArr_out As Variant
Dim tmp

    With ActiveWorkbook.Worksheets("Arkusz1")
        lRow = .Cells(.Rows.Count, 1).End(xlUp).Row

        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.Range("A1:A" & lRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange Range("A2:C" & lRow)
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        vArr_in = .Range("A2:C" & lRow + 1)
        ReDim vArr_out(1 To lRow, 1 To 3)

        For i = 1 To lRow - 1
            z = z + 1
            Do
                x = x + 1
                vArr_out(z, 1) = vArr_in(i, 1)
                vArr_out(z, 2) = vArr_out(z, 2) & x & ". " & vArr_in(i + x - 1, 2) & vbCrLf
                vArr_out(z, 3) = vArr_out(z, 3) & x & ". " & vArr_in(i + x - 1, 3) & vbCrLf
            Loop Until vArr_in(i + x - 1, 1) <> vArr_in(i + x, 1)
            i = i + x - 1
            x = 0
        Next i

        .Range("F2:H" & z + 1).Value = vArr_out

        With .Columns("A:H")
            .EntireColumn.AutoFit
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlTop
        End With

    End With

End Sub

Patrz załącznik.

mikimike.xlsm
Pobierz Plik ściągnięto 7 raz(y) 19.8 KB

_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
ID posta: 402308 Skopiuj do schowka
 
 
mikimike
Forumowicz


Posty: 11
Wysłany: 18-03-2021, 10:55   

Dziękuję Marecki, ale dla mnie to za trudne.
Zobacz załączyłem plik excel, na którym pracuje.
Na dole dałem dwie zakładki WEJSCIOWA i WYJŚCIOWA bo pewnie nie da się inaczej tego zrobic.
Wrzuciłem dane testowe bo nie mogę podać z oczywistych powodów danych poprawnych.
Mam ponad 1tys rekordów w tym excelu i nie wszystkie jak widzisz się powtarzają z nr działki czyli kolumnie G.

W danych WYJSĆIOWE zależy mi więc na tym co zrobiłeś, ale pod kątem tej docelowej tabeli, którą załączyłem - nie umiem wrzucić tego makra po prostu.

Reasumując dane, które chciałbym zgrupować to dane z kolumn S, T i U jak we wcześniejszym przykładzie względem kolumny G.

Z góry dziękuję.

test.xlsx
Pobierz Plik ściągnięto 9 raz(y) 30.11 KB

ID posta: 402314 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Wersja: Win Office 2019
Pomógł: 2521 razy
Posty: 8407
Wysłany: 18-03-2021, 17:30   

Po primo:
Dałem Ci odnośnik do tego jak uzyskać szybką i konkretną odpowiedź.
Co prawda przeczytałeś go, ale nie zastosowałeś się do wszystkiego, a kolega Kaper napisał
Cytat:
Ważne, żeby dane miały taki sam układ jak dane w prawdziwym pliku.
a Ty to olałeś.
Myślę że na przyszłość będziesz o tym pamiętał.

Po drugie primo:
Opis problemu enigmatyczny ,co z resztą danych, z innych kolumn ?

Patrz załącznik.

mikimike-v2.xlsm
Pobierz Plik ściągnięto 8 raz(y) 42.35 KB

_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
ID posta: 402349 Skopiuj do schowka
 
 
mikimike
Forumowicz


Posty: 11
Wysłany: 19-03-2021, 08:14   

Hej. Reszta danych nie jest ważna bo ich nie ma na chwilę obecną.
Dziękuję bardzo za pomoc :beer
ID posta: 402362 Skopiuj do schowka
 
 
mikimike
Forumowicz


Posty: 11
Wysłany: 19-03-2021, 09:14   

Hej.
Działa, ale jednak pojawił się problem.

Mianowicie kolumny I, J, K, Q, R a wiec te, które mają zawartość się nie skopiowały - a dane wynikowe posortowały sobie nazwiska wg numerów działek więc nie przerzucę sobie tego nawet poprzez kopiuj wklej. Musiałoby również się więc skopiować i to 1 do 1.
Co ważne podział nazwisk oraz adresów powinien mieć punktory, a pozostałe dane już tego nie potrzebują a widzę, że w kolumnie S się zrobiły.

Jeśli możesz poproszę więc o wskazówkę jak zmienić to w kodzie - która linijka za co odpowiada to sobie poprawię samodzielnie bo głupio mi już Ciebie prosić o pomoc ponownie.
ID posta: 402366 Skopiuj do schowka
 
 
Marecki 
Excel Expert



Wersja: Win Office 2019
Pomógł: 2521 razy
Posty: 8407
Wysłany: 19-03-2021, 09:45   

mikimike napisał/a:
Reszta danych nie jest ważna
,a jednak
mikimike napisał/a:
Mianowicie kolumny I, J, K, Q, R a wiec te, które mają zawartość się nie skopiowały
ważne, i o tym pisałem.
Teraz piszesz o kolumnach I, J, K, Q, R , a za chwile dojdą nowe dane do innych kolumn i znów powtórzy się sytuacja, że trzeba będzie poprawiać kod.

mikimike napisał/a:
Co ważne podział nazwisk oraz adresów powinien mieć punktory, a pozostałe dane już tego nie potrzebują a widzę, że w kolumnie S się zrobiły.
Zrobiły się, bo dałeś taki przykład w pierwszym poście, więc tego się trzymałem. Nie było mowy o tym że punktory mają być tylko w konkretnych kolumnach.

Nie wiem czy mi czas na to pozwoli aby poprawić kod, być może dopiero w czwartek do tego przysiądę.

Zadanie dla Ciebie.
Uzupełnij WSZYSTKIE dane w arkuszu "DANE WEJŚCIOWE", i z palca wpisz oczekiwany rezultat w arkuszu "DANE WYJŚCIOWE".

Jak to zrobisz i zamieścisz nowy załącznik, to może nie będziesz musiał czekać do czwartku, bo ktoś inny podejmie się tematu, a zadanie nie jest skomplikowane.
_________________
Hardware - ta część komputera, którą można kopnąć kiedy software przestanie funkcjonować.

Szkolenia z Excela , FB
Office 2019 Professional Plus , Windows 10 x64
Pozdrawiam, były mkkk23 teraz Marecki.
ID posta: 402367 Skopiuj do schowka
 
 
mikimike
Forumowicz


Posty: 11
Wysłany: 19-03-2021, 11:23   

W załączeniu plik z danymi zgodnie z tym co napisałeś.
Dane wejściowe i dane wyjsciowe jako przyklad podane w pliku.

test.xlsx
Pobierz Plik ściągnięto 9 raz(y) 30.09 KB

ID posta: 402373 Skopiuj do schowka
 
 
kuma 
Excel Expert


Wersja: Win Office 2010
Pomógł: 1453 razy
Posty: 4169
Wysłany: 22-03-2021, 17:19   

Moja próba z wykorzystaniem 'Dictionary'.

test(3)_kuma.xlsm
Pobierz Plik ściągnięto 10 raz(y) 42.23 KB

_________________
Pozdrawiam.
ID posta: 402554 Skopiuj do schowka
 
 
umiejead 
Excel Expert


Wersja: Win Office 2013
Pomógł: 796 razy
Posty: 4303
Wysłany: 22-03-2021, 18:19   

OK. Ale zadeklaruj (dla zasady) zmienną "x".
.
_________________
.
Jak poprawnie opisać problem: http://www.excelforum.pl/...ika-vt59262.htm
Chcesz precyzyjną odpowiedź - zadaj precyzyjne pytanie.
ID posta: 402555 Skopiuj do schowka
 
 
mikimike
Forumowicz


Posty: 11
Wysłany: 25-03-2021, 10:08   

Hej i jak uda się Wam pomoc? :) Będę dozgonnie wdzieczny :)
ID posta: 402728 Skopiuj do schowka
 
 
kuma 
Excel Expert


Wersja: Win Office 2010
Pomógł: 1453 razy
Posty: 4169
Wysłany: 27-03-2021, 09:10   

Koło ratunkowe zostało rzucone, a teraz zależy jak je wykorzysta potrzebujący pomocy :-P
_________________
Pozdrawiam.
ID posta: 402818 Skopiuj do schowka
 
 
mikimike
Forumowicz


Posty: 11
Wysłany: 29-03-2021, 08:14   

kuma napisał/a:
Moja próba z wykorzystaniem 'Dictionary'.

Ciężko mi to wykorzystać - Marecki zaimplementował przycisk, który aktywował makro.
W pliku od Ciebie nie wiem jak je aktywować po wrzuceniu danych do zakładki dane wejsciowe :) tak aby znalazły się w danych wyjściowych
ID posta: 402890 Skopiuj do schowka
 
 
kuma 
Excel Expert


Wersja: Win Office 2010
Pomógł: 1453 razy
Posty: 4169
Wysłany: 29-03-2021, 09:45   

Myślałem, że poradzisz sobie z uruchomieniem procedury.
Wystarczy użyć przycisków na klawiaturze: lewy ALT + F8 ---> 'Scalanie_kuma' ---> przycisk 'Uruchom' i gotowe.
Na wszelki wypadek, dodałem przycisk 'Wykonaj scalanie' w arkuszu 'DANE WEJŚCIOWE'.

Scalanie_kuma.xlsm
Pobierz Plik ściągnięto 9 raz(y) 44.29 KB

_________________
Pozdrawiam.
ID posta: 402894 Skopiuj do schowka
 
 
mikimike
Forumowicz


Posty: 11
Wysłany: 30-03-2021, 08:55   

Jeśli odnosisz się do poprzedniego postu, nie cytuj całości.

Po wklejeniu danych i wciśnieciu przycisku...

Niestety błąd - Run-time error '13'
Type Mismatch

Nie wiem czy to ma wplyw, ale w niektorychwierszach mam juz scalone dane bo robilem to w miedzy czasie recznie :)
po wcisnieciu DEBUG pojawia sie to na żółto::(
Kod:
.DataBodyRange(1, 2).Resize(UBound(rws), UBound(a, 2)).Value = _
                    Application.Transpose(Application.Index(a, rws, Evaluate("row(1:" & UBound(a, 2) & ")")))

P.S. Używaj polskich znaków, bp czasami otrzymuje się co najmniej dziwny wydźwięk danego wyrazu ;-)
ID posta: 402946 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