Potreboval bych pomoci s tvorbou makra pro Excel.
Mam sloupce A az K. Sloupec C,E,G,I a K obsahuji vzdy v kazdem radku v bunce bud pismeno X nebo nic. X mi oznacuje zda je predchozi sloupec, tedy B,D,F.H a J, spravne (jde o testovou databazi). Sloupce B,D,F,H a J obsahuji text. Sloupec A je zadani otazky.
Potreboval bych poradit jak udelat, aby Excel precetl celou tabulku - cca 2000 radku a pokud najde na radku ve sloupci C,E,G,I,K pismeno X (jak jsem psal muze tam byt jedno nebo az ctyri), vlozil do predchoziho sloupce (tj. B,D,F,H,J) na zacatek textu novy retezec "True=" (bez "").
Pokud by jeste bylo mozne pak vymazat radek c.1 a sloupce C,E,G,I,K bylo by to fajn. Jde to nejak? Poradite? Od vcerejska pronikam do tajemstvi VBS v Excelu a nejak mi to nejde pochopit.
Req: Pomoc s makrem pro Excel Vyřešeno
- mike007
- Master Level 7.5
- Příspěvky: 5860
- Registrován: srpen 07
- Bydliště: Pardubice
- Pohlaví:
- Stav:
Offline
- Kontakt:
Re: Req: Pomoc s makrem pro Excel
Vítej na Pc-help
Nevím, zda jsem to pochopil správně. Příště by nebylo na škodu přiložit nějaký příklad (tabulku) do Excelu.
Tady je makro:
Nevím, zda jsem to pochopil správně. Příště by nebylo na škodu přiložit nějaký příklad (tabulku) do Excelu.
Tady je makro:
Kód: Vybrat vše
Sub makaron()
' === projdeme sloupečky C-E-G-I-K, zda se tam nachází X ===
' === pokud ano, provedeme zápis slova True= před text
For c = 2 To Range("C65536").End(xlUp).Row
If Cells(c, 3) = "X" Then Cells(c, 2) = "True=" & Cells(c, 2)
Next c
For e = 2 To Range("E65536").End(xlUp).Row
If Cells(e, 5) = "X" Then Cells(e, 4) = "True=" & Cells(e, 4)
Next e
For g = 2 To Range("G65536").End(xlUp).Row
If Cells(g, 7) = "X" Then Cells(g, 6) = "True=" & Cells(g, 6)
Next g
For i = 2 To Range("I65536").End(xlUp).Row
If Cells(i, 9) = "X" Then Cells(i, 8) = "True=" & Cells(i, 8)
Next i
For k = 2 To Range("K65536").End(xlUp).Row
If Cells(k, 11) = "X" Then Cells(k, 10) = "True=" & Cells(k, 10)
Next k
' === smažeme první řádek (pravděpodobně hlavičku) a sloupce s X ===
Range("C:C,E:E,G:G,I:I,K:K").Delete Shift:=xlToLeft
Cells(1, 1).EntireRow.Delete
End Sub
Nejlepší hra je Excel!
• Pravidla fóra PC-help • Jak označit téma za vyřešené
»»»»»»»»»»»»»»»»»»»»»»»
UPOZORNĚNÍ - můj Skype, Soukromé zprávy či email neslouží jako tech. podpora.
Dotazy pište do fóra. Od toho tu je.
• Pravidla fóra PC-help • Jak označit téma za vyřešené
»»»»»»»»»»»»»»»»»»»»»»»
UPOZORNĚNÍ - můj Skype, Soukromé zprávy či email neslouží jako tech. podpora.
Dotazy pište do fóra. Od toho tu je.
-
- Level 4
- Příspěvky: 1142
- Registrován: srpen 08
- Pohlaví:
- Stav:
Offline
Re: Req: Pomoc s makrem pro Excel
Jestli jsem to dobre pochopil, pak takto:
Kód: Vybrat vše
Option Explicit
Option Compare Text 'nerozlisuji se mala a velka pismena
Sub TestVyhodnot()
Dim Oblast As Range, Radek As Range, Bunka As Range
Set Oblast = ActiveSheet.UsedRange
For Each Radek In Oblast.Rows
For Each Bunka In Radek.Cells
If Bunka.Value = "x" Then Bunka.Offset(0, -1).Value = "True=" & Bunka.Offset(0, -1).Value
Next Bunka
Next Radek
ActiveSheet.Range("C:C,E:E,G:G,I:I,K:K").Delete
ActiveSheet.Range("1:1").Delete
End Sub
- mike007
- Master Level 7.5
- Příspěvky: 5860
- Registrován: srpen 07
- Bydliště: Pardubice
- Pohlaví:
- Stav:
Offline
- Kontakt:
Re: Req: Pomoc s makrem pro Excel
dhous: Můžeš si vybrat
Nejlepší hra je Excel!
• Pravidla fóra PC-help • Jak označit téma za vyřešené
»»»»»»»»»»»»»»»»»»»»»»»
UPOZORNĚNÍ - můj Skype, Soukromé zprávy či email neslouží jako tech. podpora.
Dotazy pište do fóra. Od toho tu je.
• Pravidla fóra PC-help • Jak označit téma za vyřešené
»»»»»»»»»»»»»»»»»»»»»»»
UPOZORNĚNÍ - můj Skype, Soukromé zprávy či email neslouží jako tech. podpora.
Dotazy pište do fóra. Od toho tu je.
Re: Req: Pomoc s makrem pro Excel Vyřešeno
Diky moc za pomoc. Funguje to skvele. Budu se ted muset ponorit hloubeji do studia tech skriptu...
-
- Mohlo by vás zajímat
- Odpovědi
- Zobrazení
- Poslední příspěvek
-
- 16
- 7088
-
od mirekol
Zobrazit poslední příspěvek
20 říj 2023 08:31
-
- 3
- 2442
-
od Story-Long
Zobrazit poslední příspěvek
14 srp 2023 10:11
-
- 5
- 3018
-
od mmmartin
Zobrazit poslední příspěvek
13 črc 2023 18:44
-
-
Excel komparacedvou soborů Příloha(y)
od teichmann.ondrej » 15 dub 2024 17:26 » v Kancelářské balíky - 11
- 3862
-
od teichmann.ondrej
Zobrazit poslední příspěvek
22 dub 2024 15:45
-
-
- 1
- 861
-
od Grimm
Zobrazit poslední příspěvek
12 bře 2024 21:43
Kdo je online
Uživatelé prohlížející si toto fórum: Žádní registrovaní uživatelé a 5 hostů