-
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
-
Fferi50
Topikgazda
válasz
pirit28
#29304
üzenetére
Szia!
Ezt a makrót beteszed egy modul lapra (de akár az adott munkalap kódlapjára is teheted), majd elindítod. Persze tetszés szerint átnevezheted.
A makró végigmegy a C oszlopon az utolsó nem üres celláig és beírja a C oszlopban levő érték alapján a D oszlopba a kívánt értéket (ez utóbbit csak remélem, hogy eltaláltam).
Annyiszor futtatod, ahányszor akarod, mindig újraírja a D oszlop celláit az aktuális C oszlop szerint.Sub kitalalo()
Const oes = "hattorf,Győr,Ford,Pors,BMW,AUDI,hmmc,kms,Sassenburg,Figueruelas,Grossmehring,Sindelfingen,Bremen,Koeln,Voelklingen,Seat,emden,Genk,Daventry,VW,BENZ,Swarzedz,Hannover,(OE)"
Const whs = "WH,W/H"
Dim beir As String, cl As Range
For Each cl In Range("C11:C" & Cells(Rows.Count, "C").End(xlUp).Row).Cells
If cl.Value = "" Then
beir = ""
Else
If oes Like "*" & cl.Value & "*" Then
beir = "OE"
Else
If whs Like "*cl.value" & "*" Then
beir = "W/H"
Else
beir = "DFC"
End If
End If
End If
cl.Offset(0, 1).Value = beir
Next
End SubÜdv.
Új hozzászólás Aktív témák
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Microsoft Office 2024 Home Business dobozos
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Vírusirtó, Antivirus, VPN kulcsok GARANCIÁVAL!
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- BESZÁMÍTÁS! Asrock B450M R7 2700 16GB DDR4 512GB SSD GTX 1660 Super 6GB ZALMAN S4 FSP 500W
- Eladó ÚJ TCL 501 2/32GB fekete / 12 hó jótállás
- PC - Számítógép akár játékra // i5 // GTX 750Ti // Számla + Garancia //
- 245 - Lenovo LOQ (15IRX9) - Intel Core i7-13650HX, RTX 4060 (ELKELT)
- Garmin Forerunner 405 GPS óra
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest
Fferi50