-
Fototrend
A Microsoft Excel topic célja segítséget kérni és nyújtani Excellel kapcsolatos problémákra.
Kérdés felvetése előtt olvasd el, ha még nem tetted.
Ú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 SubA 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 SubJó munkát! Üdv
Kati
Új hozzászólás Aktív témák
- A ZTE sem maradt adós csúcstelefonnal
- Milyen asztali (teljes vagy fél-) gépet vegyek?
- Hobby elektronika
- TCL LCD és LED TV-k
- OLED TV topic
- Békéscsaba és környéke adok-veszek-beszélgetek
- Google Chrome
- Apple iPhone 17 - alap
- Azonnali navigációs kérdések órája
- Audi, Cupra, Seat, Skoda, Volkswagen topik
- További aktív témák...
- Bomba ár! Lenovo ThinkPad T450s - i5-5GEN I 8GB I 240GB SSD I 14" HD+/FHD I Cam I W10 I Garancia!
- Gamer PC-Számítógép! Csere-Beszámítás! R5 8400F / RX 6800 16GB / 32GB DDR5 / 1TB SSD
- Gamer PC-Számítógép! Csere-Beszámítás! R5 5600X / RX 7600 / 32GB DDR4 / 1TB M.2 SSD
- ÚJ BONTATLAN Apple Macbook Air 15,3 M4 10C CPU/10C GPU/16GB/256GB - Égkék - HUN - mc7a4mg/a 3 év gar
- Targus Universal USB 3.0 DV1K-2K Compact docking station (DisplayLink)
Állásajánlatok
Cég: NetGo.hu Kft.
Város: Gödöllő
Cég: Promenade Publishing House Kft.
Város: Budapest
Fferi50
