Keresés

Új hozzászólás Aktív témák

  • Delila_1

    veterán

    válasz Acustic #35720 üzenetére

    Szia Attila!

    Az első makrót a laphoz kell rendelned. Mikor a H oszlopba beírsz, vagy bemásolsz egy nevet, akkor ez a cella, valamint az A oszlopban lévő, azonos tartalmú cellák háttere sárga lesz. Az első, A oszlopban lévő név cellája lesz kijelölt.

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ter As Range, CV As Object
    If Target.Column = 8 Then
    Set ter = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
    For Each CV In ter
    If CV = Target Then
    CV.Interior.Color = vbYellow
    CV.HorizontalAlignment = xlRight
    CV.VerticalAlignment = xlTop
    End If
    Next
    Range(Target.Address).Interior.Color = vbYellow
    Range(Target.Address).HorizontalAlignment = xlRight
    Range(Target.Address).VerticalAlignment = xlTop
    Range("A" & Application.WorksheetFunction.Match(Target, Columns(1), 0)).Select
    End If
    End Sub

    A második makró modulba kerül. Ehhez rendelj billentyű kombinációt, aminek hatására indul a makró. Az aktuális cella háttere piros lesz, a kijelölés a következő, ilyen nevet tartalmazó cellára ugrik az A oszlopban. Mikor a kombinációval befejezted a szereplőhöz tartozó összes cella átszínezését, a H oszlopban is pirosra vált a név cellája, ez lesz kijelölt. Üzenetet kapsz, hogy a szereplő összes sora kész van.

    Sub Piros()
    Dim sor, nev As String

    If Selection.Column = 1 Then
    nev = Selection.Value
    On Error GoTo KeszVan
    sor = Range("A" & Selection.Row + 1 & ":A10000").Find(nev).Row
    Selection.Interior.Color = vbRed
    Selection.HorizontalAlignment = xlLeft
    Cells(sor, "A").Select
    End If
    Exit Sub

    KeszVan:
    Selection.Interior.Color = vbRed
    Selection.HorizontalAlignment = xlLeft
    sor = Columns(8).Find(nev).Row
    Cells(sor, "H").Interior.Color = vbRed
    Cells(sor, "H").HorizontalAlignment = xlLeft
    Cells(sor, "H").Select

    MsgBox nev & " minden sora kész van.", vbInformation, "Értesítés"
    End Sub

    Jó munkát! Üdv
    Kati

Új hozzászólás Aktív témák