Hirdetés
- GoodSpeed: Márkaváltás sok-sok év után
- Gurulunk, WAZE?!
- sziku69: Szólánc.
- Luck Dragon: Asszociációs játék. :)
- sziku69: Fűzzük össze a szavakat :)
- Mr Dini: Mindent a StreamSharkról!
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- GoodSpeed: A RAM-válság és annak lehetséges hatásai
- eBay-es kütyük kis pénzért
- gban: Ingyen kellene, de tegnapra
-
LOGOUT
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
-
Mutt
senior tag
-
Fferi50
Topikgazda
válasz
GreenIT
#38859
üzenetére
Szia!
Próbáld ki ezt a makrót:
Sub Makró1()
'
' Összesítés
Dim ws As Worksheet, uszlp As Integer, wso As Worksheet, wss
Set wss = Sheets(Array("Munka1", "Munka2", "Munka3"))
wss.Copy after:=Sheets(Sheets.Count)
For Each ws In wss
With ws
uszlp = .Range("A1").End(xlToRight).Column
.Rows(2).Insert shift:=xlDown
With .Range(.Cells(2, 2), .Cells(2, uszlp))
.Formula = "=RIGHT(""000""&COLUMN(),3)&B1&$A$1"
.Value = .Value
End With
.Rows(1).Delete shift:=xlUp
End With
Next
Set wso = Sheets.Add(after:=Sheets(3))
wso.Name = "MunkaÖ (S)"
Selection.Consolidate Sources:=Array(Sheets("Munka1").Range("A1").CurrentRegion.Address(external:=True, ReferenceStyle:=xlR1C1), _
Sheets("Munka2").Range("A1").CurrentRegion.Address(external:=True, ReferenceStyle:=xlR1C1), Sheets("Munka3").Range("A1").CurrentRegion.Address(external:=True, ReferenceStyle:=xlR1C1)), Function:= _
xlSum, TopRow:=True, LeftColumn:=True, CreateLinks:=False
Range("A1").CurrentRegion.Offset(0, 1).Sort key1:=Rows(1), order1:=xlAscending, Orientation:=xlSortRows, Header:=xlYes
With wso
uszlp = .Range("B1").End(xlToRight).Column
.Rows(2).Insert shift:=xlDown
.Range(.Cells(2, 2), .Cells(2, uszlp)).Formula = "=MID(B1,4,LEN(B1)-4)"
.Range(.Cells(2, 2), .Cells(2, uszlp)).Value = .Range(.Cells(2, 2), .Cells(2, uszlp)).Value
.Rows(3).Insert shift:=xlDown
.Range(.Cells(3, 2), .Cells(3, uszlp)).Formula = "=right(B1,1)"
.Range(.Cells(3, 2), .Cells(3, uszlp)).Value = .Range(.Cells(3, 2), .Cells(3, uszlp)).Value
.Rows(1).Delete shift:=xlUp
.Range("A1").Value = "M"
End With
For Each ws In Sheets
If InStr(ws.Name, "(") = 0 Then
ws.Delete
Else
ws.Name = Left(ws.Name, InStr(ws.Name, "(") - 2)
End If
Next
End Sub
A munkanap nevek helyére írd a nálad levő neveket. Csak ez a három munkalap legyen indulóban a munkafüzetben.Üdv.
-
ny.janos
tag
válasz
GreenIT
#38859
üzenetére
Szia!
Ha a B2 cellától jobbra és lefelé található értékeid a K, P és S munkalapokon állandóak és a sorok mindegyik munkalapon azonos sorrendben vannak, nem változnak, akkor simán átmásolod az értékeket az M munkalapra, úgy, hogy a másolást követően beszúrsz egy üres sort az "A"-s oszlopazonosítók alá, majd Ctrl+Enterrel beviszed a K, a P és az S azonosítókat az első 58, második 58 és harmadik 58 oszlopba. Ez 1-2 percet vehet igénybe. Ezt követően kijelölöd az M munkalap teljes területét, majd sorba rendezed oszlopok szerint.

Ha az első három munkalapon az értékek változnak, úgy az M munkalapon a K, P és S munkalapra hivatkozz
=K!B2formában, s másold a képletet.Ha a soraid nincsenek ugyanazon azonosító szerint rendezve a K, P és S munkalapokon, akkor az FKERES függvényt használd az adatok megkereséséhez az M munkalapon. A harmadik argumentumot az FKERES függvényben a SOR vagy SOROK függvénnyel add meg.
Ha az értékeid változnak, vagy a soraid sorrendjei a munkalapokon nem azonosak, úgy a sorba rendezés oszlopok szerint természetesen az utolsó lépés legyen.
Új hozzászólás Aktív témák
- VR topik (Oculus Rift, stb.)
- GoodSpeed: Márkaváltás sok-sok év után
- Kávé kezdőknek - amatőr koffeinisták anonim klubja
- Assassin's Creed: Valhalla
- BestBuy ruhás topik
- Hálózati / IP kamera
- GL.iNet Flint 2 (GL-MT6000) router
- Samsung Galaxy Watch8 - Classic - Ultra 2025
- OLED TV topic
- Google Pixel topik
- További aktív témák...
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- BLACK FRIDAY! - Jogtiszta Windows - Office & Vírusirtó licencek- Azonnal - Számlával - Garanciával
- Stalker Clear Sky Limited Collector's Edition
- Fallout 4 Pip-Boy Edition
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- HIBÁTLAN iPhone 14 Pro Max 128GB Purple -1 ÉV GARANCIA - Kártyafüggetlen, MS3918, 100% Akkumulátor
- 172 - Lenovo Legion Pro 7 (16IAX10H) - Intel Core U9 275HX, RTX 5080
- Lenovo ThinkPad T14s Gen 2 i5-1135G7 4.2GHz turbo 16GB 512GB 1 év garancia
- 137 - Lenovo Legion Pro 7 (16IRX9H) - Intel Core i9-14900HX, RTX 4080 - 4 ÉV GARANCIA!
- Samsung Galaxy A35 5G 256GB, Kártyafüggetlen, 1 Év Garanciával
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: ATW Internet Kft.
Város: Budapest

Fferi50
