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: 19360
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: 19360
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
  • Výběr PC podle her Příloha(y)
    od buripe » 13 pro 2024 16:16 » v Rady s výběrem hw a sestavením PC
    6
    1914
    od buripe Zobrazit poslední příspěvek
    15 pro 2024 18:21
  • Která PC sestava je podle vás nejlepší? Příloha(y)
    od Rhadley » 04 lis 2024 16:34 » v Rady s výběrem hw a sestavením PC
    4
    1846
    od Kminek Zobrazit poslední příspěvek
    05 lis 2024 09:03
  • Sejmuti textu ve win 11 - vystřižky Příloha(y)
    od L.L » 08 říj 2024 21:17 » v Programy ke stažení
    1
    2692
    od petr22 Zobrazit poslední příspěvek
    10 říj 2024 11:22
  • Rozdělení sítě na podsítě, výpočet podsítí podle počtu hostů Příloha(y)
    od zuzana3 » 27 pro 2024 08:09 » v Administrace sítě
    12
    5003
    od petr22 Zobrazit poslední příspěvek
    27 pro 2024 12:29
  • Výber UPS
    od TheSalon112 » 18 črc 2024 20:29 » v Rady s výběrem hw a sestavením PC
    2
    3520
    od TheSalon112 Zobrazit poslední příspěvek
    18 črc 2024 21:08

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

Kdo je online

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