Výběr podle barvy textu

Programy pro práci v kanceláři (Word, Excel, Access…=>Office)

Moderátor: Mods_senior

Sára
nováček
Příspěvky: 2
Registrován: srpen 07
Pohlaví: Nespecifikováno
Stav:
Offline

Výběr podle barvy textu

Příspěvekod Sára » 21 srp 2007 15:17

Dobrý den,
potřebuji poradit s funkcí vyhledávání barevného textu. Ze souboru (X), ve kterém jsou některé řádky červeně potřebuji tyto převést do jiného souboru(Y). Musí být propojeny, neboť v původním souboru (X) se bude barva řádku měnit a v souboru Y mají být jen červené z X.
Děkuji
Sára

Reklama
Uživatelský avatar
X
Elite Level 12.5
Elite Level 12.5
Příspěvky: 19325
Registrován: květen 07
Pohlaví: Muž
Stav:
Offline
Kontakt:

Příspěvekod X » 21 srp 2007 16:23

Z jakého programu?

Sára
nováček
Příspěvky: 2
Registrován: srpen 07
Pohlaví: Nespecifikováno
Stav:
Offline

Příspěvekod Sára » 22 srp 2007 11:20

Je to Excel.
Sára

Uživatelský avatar
X
Elite Level 12.5
Elite Level 12.5
Příspěvky: 19325
Registrován: květen 07
Pohlaví: Muž
Stav:
Offline
Kontakt:

Příspěvekod X » 22 srp 2007 17:00

Tak to se bude muset řešit asi ve VBA. Doporučím ty jednu e-mailovou konferenci, kde jsou ty největší odborníci přes Excel:

http://www.pandora.cz/conference/excel

Uživatelský avatar
mikel
Level 5
Level 5
Příspěvky: 2298
Registrován: květen 05
Bydliště: Karviná
Pohlaví: Muž
Stav:
Offline

Příspěvekod mikel » 15 zář 2007 17:06

Trochu pozdě, ale snad to bude k něčemu. Takže tady je makro, které udělá přesně to co chceš.

Kód: Vybrat vše

Sub Prenos()
 Dim Cil As Workbook, Zdroj As Workbook
 Dim Bunka As Range
  Set Zdroj = ActiveWorkbook
  Set Cil = Workbooks.Add
  Set Bunka = Cil.Sheets(1).Range("A1")

  Zdroj.Activate
  Range("A1").Select   'první buňka textu - nutno nastavit podle skutečné tabulky
  Do
    If ActiveCell.Font.ColorIndex = 3 Then
      ActiveCell.EntireRow.Copy
      Bunka.PasteSpecial
      Set Bunka = Bunka.Offset(1, 0)
    End If
    ActiveCell.Offset(1, 0).Activate
  Loop Until ActiveCell.Value = ""
  Application.CutCopyMode = False
  Cil.Activate
  Sheets(1).Range("A1").Select
End Sub


Na začátku si vytvoří nový sešit a v tom původním prochází buňky od první buňky textu (v tomto případě A1), až dokud nenarazí na prázdnou buňku. Pokud při procházení narazí na červený text, tak celý příslušný řádek zkopíruje do nového souboru.
Znáte pravidla?
Tipy a triky ve Windows XP
Návody: HijackThis, MWAV, CCleaner (THX to mijaja)
Problémy, které chcete vyřešit pište sem do fóra. Neposílejte je emailem ani po ICQ!


  • Mohlo by vás zajímat
    Odpovědi
    Zobrazení
    Poslední příspěvek
  • Monitor měnící barvy
    od BlackTroT » 01 úno 2024 08:12 » v Problémy s hardwarem
    1
    512
    od ITCrowd Zobrazit poslední příspěvek
    01 úno 2024 08:20
  • Problém s videem (rozsypané barvy) Příloha(y)
    od doudinin » 28 srp 2023 17:03 » v Multimédia (filmy, hudba, CDs/DVDs)
    6
    1806
    od doudinin Zobrazit poslední příspěvek
    28 srp 2023 20:37
  • Převod formatovaného textu na normalní.
    od BigSandy » 26 kvě 2023 07:27 » v Vše ostatní (sw)
    3
    1511
    od BigSandy Zobrazit poslední příspěvek
    26 kvě 2023 09:49
  • Ilustrator 2020 - problém textu v křivce Příloha(y)
    od showpayne » 13 srp 2023 17:50 » v Design a grafické editory
    4
    1918
    od Grander Zobrazit poslední příspěvek
    14 srp 2023 14:44
  • Výběr MB AM5
    od sasshrek » 03 pro 2023 16:48 » v Rady s výběrem hw a sestavením PC
    2
    876
    od sasshrek Zobrazit poslední příspěvek
    03 pro 2023 17:07

Zpět na “Kancelářské balíky”

Kdo je online

Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 5 hostů