Geek tričko zdarma Python týden
Tričko zdarma! Stačí před dobitím bodů použít kód TRIKO15. Více informací zde
Pouze tento sleva až 80% na kurzy Python

Diskuze: Ciklus VBA pomoc

C# .NET .NET (C# a Visual Basic) Ciklus VBA pomoc American English version English version

Aktivity (4)
Avatar
Radek Klepáček
Člen
Avatar
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
Avatar
Petr Stastny
Redaktor
Avatar
Odpovídá na Radek Klepáček
Petr Stastny: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
Avatar
Radek Klepáček
Člen
Avatar
Odpovídá na Petr Stastny
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
Avatar
Tarantula222
Člen
Avatar
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!
Avatar
Petr Stastny
Redaktor
Avatar
Odpovídá na Radek Klepáček
Petr Stastny: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
Avatar
Tarantula222
Člen
Avatar
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('Stra­tegicke 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!
Avatar
Radek Klepáček
Člen
Avatar
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
Avatar
Tarantula222
Člen
Avatar
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í
Řešení problému
Nahoru Odpovědět  +1 15.6.2018 22:48
Chceš realizovat své sny? Probuď se!
Avatar
Radek Klepáček
Člen
Avatar
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
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.