Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Przenoszenie tekstu o różnych kolorach pomiędzy komórkami tabeli

11 views
Skip to first unread message

Jerzy

unread,
Apr 14, 2015, 4:09:33 AM4/14/15
to
Witam.
Problem jak w temacie: jak przenieść pomiędzy komórkami tabeli w WORD teksty różniące się między sobą kolorem.
Tabela ma dwie kolumny. W lewej są jedne pod drugimi zdania: jedne z kolorze jasnoszarym, poniżej w kolorze ciemnoszarym i tak na przemian cztery tysiące wierszy. Zdania w jednym kolorze należy przenieść do drugiej kolumny, ale w ten sposób aby zdanie przenoszone było w tym samym wierszu, co zdanie je poprzedzające (w innym kolorze) - czyli o jeden wiersz wyżej lub niżej.
Po takiej operacji co drugi wiersz będzie pusty. Tu też trzeba jakiegoś rozwiązania aby te puste wiersze potem usunąć.
Zupełnie nie wiem jak sobie z tym poradzić, tym bardziej, że nie mam żadnego doświadczenia w posługiwaniu się VBA.
To zapewne trudne wyzwanie ale może ktoś mógłby pomóc?

PM

unread,
Apr 15, 2015, 7:15:23 AM4/15/15
to
W dniu 2015-04-14 o 09:09, Jerzy pisze:
Próbujesz przerobić coś takiego?
JASNY1
CIEMNY1
JASNY2
CIEMNY2
JASNY3
CIEMNY3

na:
JASNY1 CIEMNY1
CIEMNY2 JASNY2
JASNY3 CIEMNY3


Najlepiej pokaż jakby to miało wyglądać, to coś wymyślimy.

--
PM

--- news://freenews.netfront.net/ - complaints: ne...@netfront.net ---

Paweł

unread,
Apr 17, 2015, 11:16:42 AM4/17/15
to
Tak w ramach ciekawości zrobiłem sobie takie zadanie na arkuszu Excela. Na
Wordzie też powinno działać, po zmianie indeksów komórek (wiersz, kolumna).
Działa to tak jak opisałeś. Na początku makro tworzy "n" komórek, a potem
przenosi i kasuje wiersze:
-------------------------------------------------------------
Sub komorki()
Dim a, i, n As Integer
i = 1
a = 1
n = 20
For i = 1 To n Step 1
Cells(i, 1).Value = a
a = a + 1
Next i
For i = 1 To n Step 2
Cells(i, 1).Interior.ColorIndex = 4
Next i
i = 2
For i = 2 To n Step 2
Cells(i, 1).Interior.ColorIndex = 6
Next i
For i = 2 To n Step 2
Cells(i, 1).Select
Selection.Copy
Cells(i - 1, 2).Select 'gdzie ma być skopiowane
ActiveSheet.Paste 'Wklejasz
Next i
i = 1
For i = 1 To n Step 1
Cells(i, 1).Interior.ColorIndex = 4
Cells(i, 2).Interior.ColorIndex = 6
Next i
For i = 2 To n 'usuwanie pustego wiersza
If (Cells(i, 2).Value = "") Then
Rows(i).Delete
End If
Next i
End Sub
------------------------------------------------------------

Pozdrawiam
Paweł

0 new messages