Req: Pomoc s makrem pro Excel

[dhous]

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.

[mike007]

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:

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

[navstevnik]

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]

dhous: Můžeš si vybrat

[dhous]

Diky moc za pomoc. Funguje to skvele. Budu se ted muset ponorit hloubeji do studia tech skriptu...