NOVINKA: Kurz kybernetické bezpečnosti s akreditací MŠMT, nyní již od 0 Kč. Staň se žádaným profesionálem. Zjisti více:
Avatar
Radek Klepáček
Člen
Avatar
Radek Klepáček:15.6.2018 12:12

Ahoj. Potřeboval bych pomoc se zacyklováním.

Děkuji
Radek

Zkusil jsem:

Sub Makro6()

'Zvýraznit strategické díly

    Dim lastrowA As Long
    lastrowA = Cells(Rows.Count, 1).End(xlUp).Row
    t = 1

        For Each cell In Range("C2:C" & lastrowA)
            If cell(t).Value = Sheets("Strategické díly").Range("A3:A3").Value Then
               cell(t).Interior.Color = RGB(0, 255, 0)

            Else
                t = t + 1
            End If
        Next



End Sub
Sub Makro7()

 'Zvýraznit strategické díly

    Dim lastrowA As Long
    lastrowA = Cells(Rows.Count, 1).End(xlUp).Row
    t = 1

        For Each cell In Range("C2:C" & lastrowA)
            If cell(t).Value = Sheets("Strategické díly").Range("A4:A4").Value Then
               cell(t).Interior.Color = RGB(0, 255, 0)

            Else
                t = t + 1
            End If
        Next



End Sub
Sub Makro8()

 'Zvýraznit strategické díly

    Dim lastrowA As Long
    lastrowA = Cells(Rows.Count, 1).End(xlUp).Row
    t = 1

        For Each cell In Range("C2:C" & lastrowA)
            If cell(t).Value = Sheets("Strategické díly").Range("A5:A5").Value Then
               cell(t).Interior.Color = RGB(0, 255, 0)

            Else
                t = t + 1
            End If
        Next



End Sub

Chci docílit: Pokud v listu "Urgence" sloupci "C" najdeš hodnotu z listu "Strategické díly" ze sloupce "A" , tak buňku v listě "Urgence" podbarvit zeleně.

 
Odpovědět
15.6.2018 12:12
Avatar
Peter Mlich
Člen
Avatar
Peter Mlich:20.6.2018 9:59

Proc to nemas ve VBA foru?
cYklus

VBA nepouzivam, ale psal bych to asi tak nejak

b_sh = Sheets("Strategické díly")
a_range = Range("C" & Rows.Count).End(xlUp).Row
b_range = b_sh.Range("A" & b_sh.Rows.Count).End(xlUp).Row
For Each a In a_range.Cells ' hledani vstup
  For Each b In b_range.Cells ' hledani prohledavana db
      If a.Value = b.value Then
               a.Interior.Color = RGB(128, 255, 128)
               Exit For ' ukonceni cyklu
      End If
  next b
next a

a_range - jestli to chapu spravne, tak to veme C posledni radek, skoci na prvni radek (xlUp) a cele to ulozi do range. Ale treba bude fungovat to tve.
Kazdopadne jsem nepochopil to s tim t. Tim cyklem by ses mel dostat primo na cell, ne?

 
Nahoru Odpovědět
20.6.2018 9:59
Avatar
Radek Klepáček
Člen
Avatar
Radek Klepáček:20.6.2018 10:16

Ahoj.

Byl to můj první příspěvek na tomto fóru a nevšiml jsem si že je tu VBA fórum.. Jinak už bylo vyřešeno.
I tak děkuji.

Sub StrategickeDily()

Dim rngUrgence As Range, rngBunka As Range
Dim rngStrategickeDily As Range

    With Sheets("Strategicke dily")
        Set rngStrategickeDily = .Range(.Cells(1, "A"), .Cells(.Cells(Rows.Count, "A").End(xlUp).Row, "A"))
    End With

    With Sheets("Urgence")
        Set rngUrgence = .Range(.Cells(1, "C"), .Cells(.Cells(Rows.Count, "C").End(xlUp).Row, "C"))

        For Each rngBunka In rngUrgence
            If WorksheetFunction.CountIf(rngStrategickeDily, rngBunka.Text) > 0 Then
                rngBunka.Interior.Color = RGB(0, 255, 0)
            End If
        Next
    End With
End Sub
 
Nahoru Odpovědět
20.6.2018 10:16
Děláme co je v našich silách, aby byly zdejší diskuze co nejkvalitnější. Proto do nich také mohou přispívat pouze registrovaní členové. Pro zapojení do diskuze se přihlas. Pokud ještě nemáš účet, zaregistruj se, je to zdarma.

Zobrazeno 3 zpráv z 3.