Excel Forum - Porady, Pomoc, Excel Help, Excel FAQ - Przeróbka pliku z określeniami

krnck · forumowicz Posty: 15

Witam,
Mam bazę wyrazów z określeniami

Rząd A1 wyraz np. AMANTKA
Rząd B1 określenia wyrazu oddzielone wężykiem
typ aktorki~wzdychająca aktorka~kokietuje z ekranu~flirtuje w kadrach~całuje po klapsie~filmowa kochanka

Jak rozbić to, żeby było tak
Kolumna A Kolumna B
AMANTKA typ aktorki
AMANTKA wzdychająca aktorka
AMANTKA kokietuje z ekranu
AMANTKA flirtuje w kadrach
AMANTKA całuje po klapsie
AMANTKA filmowa kochanka

lub może być z wężykiem
AMANTKA typ aktorki
AMANTKA ~wzdychająca aktorka
AMANTKA ~kokietuje z ekranu
AMANTKA ~flirtuje w kadrach
AMANTKA ~całuje po klapsie
AMANTKA ~filmowa kochanka

Trzeba do każdego wyrazu przypisać tylko jedno określenie. Przykład w załączniku

Plik.rar

Pobierz Plik ściągnięto 9 raz(y) 3.53 KB

tkuchta1 · Excel Expert **Pomógł:** 1495 razy Posty: 2270

może pomóc funkcja UDF Fragment_RegExp

Funkcje Użytkownika oparte o Wyrażenia Regularne
http://www.apocotenexcel.pl/udfregexp.htm

Bez tytułu.png

Plik ściągnięto 255 raz(y) 12.18 KB

krnck · forumowicz Posty: 15

Możesz podesłać tę funkcję w załączniku w Excelu?

Zmora · Excel Expert **Pomógł:** 763 razy Posty: 1598

W załączeniu plik + gratis 2 sposób rozwiązania.

Plik1.zip

Pobierz Plik ściągnięto 12 raz(y) 11.36 KB

krnck · forumowicz Posty: 15

Jak przerobić całą bazę? Oddzielone wężykiem określenia powinny by jedno pod drugim.
Występują również w bazie pojedyncze określenia. Fragment bazy przesyłam w załączniku (kolumny A i B), po przeróbce (kolumny C i D).

Fragment baza.rar

Pobierz Plik ściągnięto 12 raz(y) 8.93 KB

Zmora · Excel Expert **Pomógł:** 763 razy Posty: 1598

Przetestuj takie makro:

Kod:

Option Explicit

Sub podziel()

Dim i As Long, a As Long, b As Long
Dim tbl As Variant
a = Cells(Rows.Count, "A").End(xlUp).Row

For i = 1 To a
tbl = Split(Cells(i, "B"), "~")
With Sheets("Arkusz3")
b = .Cells(.Rows.Count, "b").End(xlUp).Row
.Cells(b + 1, "B").Resize(UBound(tbl) + 1, 1) = Application.Transpose(tbl)
.Cells(b + 1, "A").Value = Cells(i, "A").Value
End With
Next i
b = Sheets("Arkusz3").Cells(Rows.Count, "b").End(xlUp).Row
With Sheets("Arkusz3").Range("A2:A" & b).SpecialCells(xlCellTypeBlanks)
.FormulaR1C1 = "=R[-1]C"
End With

With Sheets("Arkusz3").Range("A2:A" & b)
.Value = .Value
End With

End Sub

krnck · forumowicz Posty: 15

Przy użyciu makra wyskakuje błąd (załącznik).

Zeszyt1.rar

Pobierz Plik ściągnięto 32 raz(y) 198.2 KB

Zmora · Excel Expert **Pomógł:** 763 razy Posty: 1598

Błąd generują znaki równości w kom

Kod:

B1796

Cytat:

ALOZA , półwędrowna ryba ze śledziowatych, planktonożerna.~>SZED (ryba)

Pozbądź się ich, a wszystko będzie działać.

krnck · forumowicz Posty: 15

Dziękuję, teraz już makro działa.
Pozdrawiam