Diskuze: Ciklus VBA pomoc

Radek Klepáček

Člen

Radek Klepáček:15.6.2018 15:45

Potřebuji pomoc zacyklovat?

Zkusil jsem:

Sub StrategickeDily()
Dim lastrowA As Long
Dim rng As Range
 lastrowA = Cells(Rows.Count, 1).End(xlUp).Row
 t = 1
 For Each cell In Range("C2:C" & lastrowA)
 If cell.Value = Sheets("Strategické díly").Range(Cells(3, 1), Cells(70, 1)).Value Then
 cell.Interior.Color = RGB(0, 255, 0)
 Else
 t = t + 1
 End If
 Next
 End Sub

Chci docílit: Potřeboval bych dosáhnout toho, aby pokud v listu "Urgence" v 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 15:45

Petr Šťastný

Tvůrce

Odpovídá na Radek Klepáček
Petr Šťastný:15.6.2018 16:06

Potřebuješ makra? Nešlo by to přes nějaké šikovné podmíněné formátování?

https://support.office.com/…F1951FF89D7F

https://duckduckgo.com/?…

Nahoru Odpovědět

15.6.2018 16:06

Radek Klepáček

Člen

Odpovídá na Petr Šťastný
Radek Klepáček:15.6.2018 16:11

Potřebuji makra, protože hodnoty se ve sloupci A neustále mění a jejich počet narůstá a klesá.
Navíc je to jedna z pod procedur z celého makra.

Nahoru Odpovědět

15.6.2018 16:11

Tarantula222

Člen

Tarantula222:15.6.2018 17:10

...bez prílohy je to na prd. Skúste makro nižšie poprípade si ho upravte alebo dajte vedieť.
Upravte si názvy listov v makre.

Nechápem:

prečo hľadáte posledný riadok v prvom stĺpci("A") keď potom pracujete so stĺpcom "C"

lastrowA = Cells(Rows.Count, 1).End(xlUp).Row
....
For Each cell In Range("C2:C" & lastrowA)

prečo používate počítadlo "t" v cykle For Each

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

15.6.2018 17:10

Chceš realizovat své sny? Probuď se!

Petr Šťastný

Tvůrce

Odpovídá na Radek Klepáček
Petr Šťastný:15.6.2018 18:21

Dobře. Jenom bych chtěl podotknout, že podmíněné formátování funguje i když se hodnoty mění a navíc jde nastavit na celý sloupeček naráz, musíš tuším kliknout na písmenko toho sloupečku, to samé u funkcí: můžeš vybrat celý sloupeček tím, že klikneš na písmeno sloupce Ale jestli to už máš rozdělané v makrech, asi to už bude rozumnější v tom nechat.

Editováno 15.6.2018 18:22

Nahoru Odpovědět

15.6.2018 18:21

Tarantula222

Člen

Tarantula222:15.6.2018 18:37

Petr Stastny má pravdu. Podmienene formátovanie by na zvýrazňovanie bolo ideálne, lepšie než použivať makro. Menný počet hodnôt ničomu nevadí.
Len to skúste, nič za to nedáte. Označte cely stĺpec "C" na liste "urgence". Pridajte podmienene formátovanie podľa vzorca a ako vzorec použite -> =COUNTIF('Strategicke dily'!$A:$A;$C1)>0
Len upravte názov listu.

Nahoru Odpovědět

15.6.2018 18:37

Chceš realizovat své sny? Probuď se!

Radek Klepáček

Člen

Odpovídá na Tarantula222
Radek Klepáček:15.6.2018 19:02

Tarantula222 -no tak to smekám. Pracuje úplně skvěle a když to takto vidím, tak mi to dává i smysl.

Jelikož jsem zde nový, nevím ještě kam přílohy nahrát, proto jsem ji neposkytl.

Chtěl bych požádat ještě o jeden cyklus a to:

pokud se číslo zakázky z listu "Urgence" nachází ve sloupci "B" na listu "Strategické díly", do sloupce "M" na listě "Urgence" datum které se nachází vedle vyhledané hodnoty na listě "Strategické díly".

Momentálně to dělám pro každou buňku zvlášť pomocí

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

    HledanaHodnota = Sheets("Strategické díly").Range("B3:B3").Value
    For i = 1 To lastrowA
    rozsah = "A" & i
      With Range(rozsah)
        Set FoundCell = .Cells.Find(What:=HledanaHodnota, _
                                After:=.Cells(.Cells.Count), _
                                LookIn:=xlFormulas, _
                                LookAt:=xlPart, _
                                searchorder:=xlByRows, _
                                searchdirection:=xlNext, _
                                MatchCase:=False)
    End With
    If FoundCell Is Nothing Then
    Else
        FoundCell.Offset(0, 12).Range("A1").Value = Sheets("Strategické díly").Range("C3:C3")
    End If
    Next i
End Sub

Děkuji Radek

Nahoru Odpovědět

15.6.2018 19:02

Tarantula222

Člen

Tarantula222:15.6.2018 22:48

...prílohu napríklad cez leteckú poštu.

Druhe makro je:

Sub Makro68()

Dim rngOblastZakazkaU As Range, rngZakazkaU As Range
Dim rngOblastZakazkaS As Range, rngZakazkaS As Range
Dim Zakazka As String

    With Sheets("Urgence")
        Set rngOblastZakazkaU = .Range(.Cells(2, "A"), .Cells(.Cells(Rows.Count, "A").End(xlUp).Row, "A"))
    End With

    With Sheets("Strategické díly")
        Set rngOblastZakazkaS = .Range(.Cells(3, "B"), .Cells(.Cells(Rows.Count, "B").End(xlUp).Row, "B"))
    End With

    For Each rngZakazkaU In rngOblastZakazkaU
        Zakazka = rngZakazkaU.Text
        For Each rngZakazkaS In rngOblastZakazkaS
            If Zakazka = rngZakazkaS.Text Then
                Sheets("Urgence").Cells(rngZakazkaU.Row, "M").Value = Sheets("Strategické díly").Cells(rngZakazkaS.Row, "C").Value
                Exit For
            End If
        Next rngZakazkaS
    Next rngZakazkaU
End Sub

Akceptované řešení
+20 Zkušeností

Nahoru Odpovědět

15.6.2018 22:48

Chceš realizovat své sny? Probuď se!

Radek Klepáček

Člen

Odpovídá na Tarantula222
Radek Klepáček:16.6.2018 4:36

Děkuji i toto rovněž pracuje skvěle.
Výsledek své práce najdeš na http://leteckaposta.cz/839170982.

To jen aby jsi viděl k čemu jsem to potřeboval.

Moc děkuji
Radek

Nahoru Odpovědět

16.6.2018 4:36

Junior programátor, plat 50.000 Kč/měsíc. Líbí? Do 6.000 Kč ho z tebe uděláme.

Zjistit více...

Junior programátor, plat 50.000 Kč/měsíc. Líbí? Do 6.000 Kč ho z tebe uděláme.

Vyzkoušet zdarma

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 9 zpráv z 9.