- One mobilszolgáltatások
- Csak semmi szimmetria: flegma dizájnnal készül a Nothing Phone (3)
- Magisk
- Telekom mobilszolgáltatások
- A sógorokhoz érkezik a kompakt Vivo X200 FE
- Yettel topik
- Milyen okostelefont vegyek?
- Samsung Galaxy Z Fold6 - ugyanaz, sarkosan fogalmazva
- Samsung Galaxy Watch (Tizen és Wear OS) ingyenes számlapok, kupon kódok
- Mobil flották
-
Mobilarena
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
zsolti_20
#42970
üzenetére
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WF As WorksheetFunction
Set WF = Application.WorksheetFunction
ActiveSheet.Protect Password:="szupertitkosjelszó", UserInterfaceOnly:=True
If WF.CountA(Range("A" & Target.Row & ":E" & Target.Row)) = 5 Then Rows(Target.Row + 1).Locked = False
If WF.CountA(Range("A" & Target.Row & ":E" & Target.Row)) = 0 Then Rows(Target.Row + 1).Locked = True
End SubEz azt csinálja, hogy ha pl. a 4. sor adatait törlöd, az 5. sor celláit zárolja. A 4. sor újra kitöltése után ismét írható lesz az ötödik.
Erre gondoltál? -
Delila_1
veterán
válasz
Szaszati
#42971
üzenetére
A nyers lapra vegyél fel két oszlopot. G1 legyen Hét, G2 képlete =HÉT.SZÁMA(C2).
H1 legyen Hét napja, H2 képlete =HÉT.NAPJA(C2). Ennek az oszlopnak a formátuma nnnn.
A kimutatásnál a szűrőkhöz Típust és a Hét oszlopokat vidd be, az oszlopokhoz a Hét napja kerül, a sorokhoz az Órák, Percek és Idő, az értékekhez kétszer az Összeg (összegként és mennyiségként).
A kész kimutatásban a Mennyiség/Összeg2 címet átírhatod Db-ra.Érdemes a nyers lapon az adatokat táblázattá alakítani – még a kimutatás létrehozása előtt –, akkor a kimutatásnál nem kell átírni a forrást a bővítéseknél, elég egy frissítést ráadni.
Szerk.: a nyers lapon törölheted az M oszlop tartalmát.
A szűrőkhöz a Dátum-ot is berakhatod. -
Delila_1
veterán
Sajnos ehhez a rendezési formához egyenként kell rendezni az egyes sorokat. A csatolt képen látszik, hogy a 19:21 sorokat úgy rendezi, hogy a 19. sor rendezését veszi elsődleges szempontnak, azután a 20-ast másodlagosnak, végül a 21-est.
Sor szerinti rendezésnél soronként kell megadni a rendezés szempontját. -
#42964
Delila_1
veterán
dreizwanzig
#42959
Delila_1
veterán
válasz
dreizwanzig
#42959
üzenetére
Tegyél autoszűrőt az oszlopra. Szűrd a 20-nál nagyobb értékekre. Jelöld ki a látható sorokat, és töröld.
-
Delila_1
veterán
válasz
zsolti_20
#42952
üzenetére
A teljes lapon zárolod a cellákat, majd levéded a lapot. Érdemes kivenni a pipát a Zárolt cellák kijelölése elől, ne is tudjon rálépni a következő sorra.
Rendeld a lenti makrót a lapodhoz (lásd a Téma összefoglalót).Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Protect Password:="szupertitkosjelszó", UserInterfaceOnly:=True
If Application.WorksheetFunction.CountA(Range("A" & Target.Row & ":E" & Target.Row)) = 5 Then
Rows(Target.Row + 1).Locked = False
End If
End SubEz a makró csak akkor szünteti meg a zárolást a KÖVETKEZŐ soron, mikor már minden adat megvan az A: E tartományban,
-
Delila_1
veterán
válasz
daddy9
#42948
üzenetére
A tiédben sem volt.
Az aktuális oszloptól BALRA lévőt fedte fel, amit az előző lépésben elrejtettél, ha éppen üres volt a 36. sor az oszlopban.
A második feltétel abszolút felesleges volt. Azt vizsgálta, hogy az aktuális oszloptól balra lévőben van-e adat, és ha igen, felfedte, de mivel az előző ciklusban nem rejtette el, hiszen nem volt üres, semmi szükség erre a sorra a makróban.
Mi az, hogy nyisson új oszlopot? Szúrjon be az aktuális oszloptól balra egyet? Melyik esetben? Ha az aktuális üres, vagy nem? -
Delila_1
veterán
válasz
daddy9
#42944
üzenetére
Ezt a makrót modulba kellene tenni, nem eseményvezéreltbe. Bár így is jó, bármelyik cellára kattintasz, lefut.
Modulba:Sub Rejt()
Dim LastColumn, i As Integer
Application.ScreenUpdating = False
LastColumn = 27 'Last Column
For i = 5 To LastColumn 'Lopping through each Column
If Cells(36, i) = "" Then
Columns(i).EntireColumn.Hidden = True
Else
Columns(i).EntireColumn.Hidden = False
End If
Next
Application.ScreenUpdating = True
End Sub -
Delila_1
veterán
válasz
rudi666
#42932
üzenetére
Nem kell megnyitogatni. Kijelölöd a K oszlop tartományát, másolod (Ctrl+C), beállsz a gyűjtő füzet megfelelő lapján a megfelelő cellába.
Ha a képleteket akarod másolni – ez mindig a sok füzet celláinak az aktuális értékét adja –, akkor Ctrl+V-vel beilleszted a képleteket.
Ha a mostani értékeket akarod fixen beilleszteni a gyűjtő füzetbe, akkor irányítottan, értékként kell beillesztened a mostani adatokat.
Gondolom, csak a csatolt kép kedvéért vannak szövegként a képletek a K oszlopban, mivel aposztróffal kezdődnek. -
-
Delila_1
veterán
Úgy látom, állandó változásban van szegény makró. A másolás sorai
ide = Sheets(lapnev).Range("B" & Rows.Count).End(xlUp).Row + 1
Sheets("Munka2").Range("A" & sor & ":F" & sor).Copy Sheets(lapnev).Range("B" & ide)
Sheets("Munka2").SelectMár csak azt kell megmondanod, hogy az A: F tartományt a másik lap A-ba, vagy B-be tegye. Ha A-ba, akkor
Sheets("Munka2").Range("A" & sor & ":F" & sor).Copy Sheets(lapnev).Range("A" & ide)
kell neked. -
Delila_1
veterán
"ezután megvizsgálja a "munka2" lap A3 celláját és ha van olyan nevű munkalap már, akkor a B oszlop következő sorába bemásolja a tartalmát, ha nincsen a cellában szereplő nevű munkalap akkor létrehozza azt, és a B2 cellájába bemásolja a "munka2" lap A3-as
cellájának a tartalmát..."
Ebből nekem úgy tűnt, hogy az eredeti adat sorába kell másolni a B oszlop tartalmát.
Beteszek egy képet, kiemelve a módosításokat.
-
-
#42884
Delila_1
veterán
sosperec18
#42883
Delila_1
veterán
válasz
sosperec18
#42883
üzenetére
Legyen fejléce a táblázatodnak.
Állsz a táblázatban, Beszúrás | Kimutatás. Megadod a helyét vagy új lapon, ahogy felajánlja, vagy az aktuális lapon kijelölsz egy cellát, ahol kezdődjön.
Kapsz egy párbeszéd ablakot, ahol fent látszanak a táblázat címsorai. A Sorok, és az Értékek mezőbe is behúzod a neveket tartalmazó oszlop címét. Ennyi. -
-
Delila_1
veterán
Fferi gyorsabb volt, de azért én is beteszem a saját makrómat.
Sub Szetvalogatas()
Dim sor As Long, lapnev As String, usor As Long, a
usor = Range("A" & Rows.Count).End(xlUp).Row
For sor = 2 To usor
lapnev = Right(Cells(sor, 1), Len(Cells(sor, 1)) - 3)
On Error Resume Next
Set a = Sheets(lapnev)
If Err.Number > 0 Then
Sheets.Add.Name = lapnev
Sheets(lapnev).Move After:=Sheets.Count
End If
Sheets(lapnev).Cells(sor, 2) = Sheets("Munka2").Cells(sor, 2)
Sheets("Munka2").Select
Next
Sheets("Munka2").Move After:=Sheets(1)
MsgBox "Kész a szétválogatás", vbInformation
End Sub -
Delila_1
veterán
Egy rövid makró a 36 kezdetű cellák másolásához.
Sub Masolas()
Dim sor As Long, ide As Long
Sheets("Munka2").Select
sor = 1
Do While Cells(sor, 1) <> ""
If Left(Cells(sor, 1), 2) = "36" Then
ide = Sheets("Munka1").Range("A" & Rows.Count).End(xlUp).Row + 1 '***
Sheets("Munka1").Cells(ide, 1) = Cells(sor, 1).Value
End If
sor = sor + 1
Loop
End SubA csillagokkal jelzett sor határozza meg a Munka1 lapon az első üres sort.
Sok adat esetén érdemes a makró elején kikapcsolni a képernyő frissítését –Application.ScreenUpdating = False
–, a végén meg visszaállítani.
Szerk.: azt is megteheted, hogy szűröd az oszlopot a 36-os kezdetre, majd a szűrt állományt másolod a Munka1-re. -
Delila_1
veterán
válasz
daddy9
#42788
üzenetére
Közben megadtad a választ arra, hogy ki mikor milyen oklevelet kap. Itt a módosított makró:
Sub Pdf()
Dim sor As Integer, oszlop As Integer, utvonal As String, FN As String
Application.ScreenUpdating = False
oszlop = 3
Do While Cells(4, oszlop) <> ""
utvonal = Cells(24, oszlop)
If Cells(7, oszlop) = "fiú" Then sor = 25 Else sor = 26
FN = Cells(sor, oszlop)
Sheets(Cells(sor, 1)).Select 'lapra állás
With Sheets("Adatbekérő")
Range("A7") = .Cells(6, oszlop) & ", " & .Cells(5, oszlop)
Range("A13") = .Cells(8, oszlop)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=utvonal & FN, _
Quality:=xlQualityStandard, IgnorePrintAreas:=False, OpenAfterPublish:=False
If .Cells(9, oszlop) = "Ügyes" Then
Sheets(.Cells(sor + 1, 1)).Select 'lapra állás
If .Cells(7, oszlop) = "fiú" Then sor = sor + 2 Else sor = sor + 1
FN = .Cells(sor, oszlop)
Range("A7") = .Cells(6, oszlop) & ", " & .Cells(5, oszlop)
Range("A13") = .Cells(8, oszlop)
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=utvonal & FN, _
Quality:=xlQualityStandard, IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
End With
Sheets("Adatbekérő").Select
oszlop = oszlop + 1
Loop
Application.ScreenUpdating = True
MsgBox "Az oklevelek el vannak mentve", vbInformation
End Sub -
-
#42648
Delila_1
veterán
csanyiadam
#42647
Delila_1
veterán
válasz
csanyiadam
#42647
üzenetére
Szívesen.
-
#42645
Delila_1
veterán
csanyiadam
#42643
Delila_1
veterán
válasz
csanyiadam
#42643
üzenetére
A lenti makrót modulba másolod. Kigyűjti egymás alá a címkéidet – mindegyikből csak egyet – a BJ oszlopba.
Sub Gyomlalas()
Dim sor As Long, usor As Long, oszlop As Long, ide As Long
usor = Range("C" & Rows.Count).End(xlUp).Row
ide = 1
For oszlop = 3 To 59 'BG oszlopig
For sor = 2 To usor
If Cells(sor, oszlop) <> "" Then
If Application.WorksheetFunction.CountIf(Columns(62), Cells(sor, oszlop)) = 0 Then
Cells(ide, 62) = Cells(sor, oszlop)
ide = ide + 1
Else
Exit For
End If
End If
Next
Next
End Sub -
#42631
Delila_1
veterán
csanyiadam
#42629
Delila_1
veterán
válasz
csanyiadam
#42629
üzenetére
Fel kell venned egy egyéni listát. Beállítások | Speciális | Általános | Egyéni listák szerkesztése. Itt a Listaelemek ablakba egymás alá beviszed a címkéket a megfelelő sorrendben (egészség, sport, stb.), Hozzáad. Ezt megjegyzi az Excel.
Most a füzetedben a C oszlop tartalmát a Szövegből oszlopok funkció segítségével szétbontod külön cellákba a vesszők mentén.
Kijelölöd a C oszloptól a rendezendő adatokat addig az oszlopig, ameddig a címkéid tartanak.
Adatok | Rendezés és szűrés | Egyéni sorrend. A Beállításoknál a Balról jobbra opciót választod. A Rendezés rovatban (sajnos) egyenként be kell vinned a rendezendő sorokat az Újabb szint kiválasztásával. A Sorrend rovatban az Egyéni listát jelölöd be, ahol a bal oldalon kiválasztod a címkéid nevét tartalmazó listát.Egy kicsit körülményes amiatt, hogy a rendezendő sorokat egyenként kell megadni.
-
-
#42614
Delila_1
veterán
dogpatch06
#42613
Delila_1
veterán
válasz
dogpatch06
#42613
üzenetére
=IF(AND(E6=0,F6=0),"",SUM(E$5:E6)-SUM(F$5:F6))A SUM-nál az E$6 helyett E6; az F$6 helyett F6 legyen. A $ jellel rögzítetted a befejező sort, ezért függőleges másolásnál megmaradt a 6. sorra való hivatkozás.
-
#42610
Delila_1
veterán
AndrewBlase
#42609
Delila_1
veterán
válasz
AndrewBlase
#42609
üzenetére
Szívesen.
-
#42608
Delila_1
veterán
AndrewBlase
#42607
Delila_1
veterán
válasz
AndrewBlase
#42607
üzenetére
P1-be
=DARAB(C3: C18) & " rendelés, " & SZUM(C3: C18) & " tétel"
persze a táblázatod oszlopaira hivatkozva. Szóközök nem kellenek. -
Delila_1
veterán
Vagy úgy formázod a cellát, ahogy ny.janos írta itt, vagy a formázandó cellán állva Feltételes formázás, Új szabály, A formázandó cellák kijelölése képlettel, majd az Értékek formázása, ha ez a képlet igaz rovatba beírod az általam javasolt képletet, csak éppen az A1 helyett annak a cellának a címét írod be, ahol a képlet van.Itt a kezdő egyenlőségjelet úgy kell értelmezni, mintha HA függvény lenne.
A képlet beírása után a Formátum gomb lenyomására kapsz egy új felületet, ahol megadod a kívánt formátumot (háttérszín, karakter típusa és színe, szegély). -
Delila_1
veterán
válasz
szente
#42546
üzenetére
Legegyszerűbben úgy, hogy MEGSZÜNTETED az összevont cellákat. Ehhez csupán 1 plusz oszlop kell a C elé. A címsor állhat 2 sorból, az A és B összevonható az első sorban (ezzel nem dolgozol később), a B2 Csapattag 1, a C2 pedig Csapattag 2.
Többször szerepelt itt a fórumon, hogy bár megengedi az Excel a cellák összevonását, de nem tudja maradéktalanul jól kezelni.
-
Delila_1
veterán
A csere funkcióval (Ctrl+h) cseréld a szóközöket semmire, majd a kigyomlált értékeket szorozd fel 1-gyel a következő módon. Egy üres cellába beírsz egy 1-est, amit másolsz Ctrl+c-vel. Kijelölöd a (még most is) szövegeket tartalmazó tartományt. Irányított beillesztés, a Műveletek csoportban jelöld be a szorzást. Az 1-est törölheted.
-
#42455
Delila_1
veterán
Nagyzoli27
#42453
Delila_1
veterán
válasz
Nagyzoli27
#42453
üzenetére
Szívesen.
-
#42450
Delila_1
veterán
Nagyzoli27
#42448
Delila_1
veterán
válasz
Nagyzoli27
#42448
üzenetére
Feltöltöttem
Nagyon sok volt a B oszlop üres cellája. Azzal kellett volna kezdenem, hogy az ezekhez tartozó ID-ket ki kellett volna törölnöm a D oszlopból a DARABTELI függvény segítségével. -
#42449
Delila_1
veterán
Nagyzoli27
#42448
Delila_1
veterán
válasz
Nagyzoli27
#42448
üzenetére
Megnyitod mindkét füzetet, a cross.xlsx-re állsz, majd indítod a makrót.
-
#42446
Delila_1
veterán
Nagyzoli27
#42445
Delila_1
veterán
válasz
Nagyzoli27
#42445
üzenetére
Ez ugyanaz, mint az előző. Ebbe a füzetben is indíthatod a makrót.
-
#42444
Delila_1
veterán
Nagyzoli27
#42443
Delila_1
veterán
válasz
Nagyzoli27
#42443
üzenetére
Mert annyi adat van a 2. táblában, ahol az első duplikációi nem szerepelnek.
-
#42442
Delila_1
veterán
Nagyzoli27
#42440
Delila_1
veterán
válasz
Nagyzoli27
#42440
üzenetére
Próbáld Itt.
-
#42439
Delila_1
veterán
Nagyzoli27
#42437
Delila_1
veterán
válasz
Nagyzoli27
#42437
üzenetére
Lehet, hogy csak egyszer lesz szükséged a makró eredményére. Itt van.
-
#42438
Delila_1
veterán
Nagyzoli27
#42437
Delila_1
veterán
válasz
Nagyzoli27
#42437
üzenetére
Módosítottam a makrón. A sok sorod miatt a változókat Long típusúnak kellett megadni, és azt nem írtad, hogy az első táblázatban vannak tételek, amikhez nem tartozik kapcsolódó ID.
Működik a makró, de nagyon sokáig fut. Érdemes megnézned Mutt ajánlatát.
Azért bemásolom ide a makrót. Kibővítettem azzal, hogy az A oszlop tartalmát átmásolja a D oszlopba, majd eltávolítja az ismétlődéseket. A makrót tartalmazó fájlt makróbarátként kell elmenteni.Sub Kapcsolodo()
Dim sor1 As Long, sor2 As Long, usor1 As Long, usor2 As Long
Columns("A:A").Copy Range("D1")
Columns("D:D").RemoveDuplicates Columns:=1, Header:=xlYes
Range("B1").Copy Range("E1")
usor1 = Range("A1").End(xlDown).Row
usor2 = Range("D1").End(xlDown).Row
For sor2 = 2 To usor2
For sor1 = 2 To usor1
If Cells(sor1, 2) <> "" Then
If Cells(sor2, 4) = Cells(sor1, 1) Then
If Cells(sor2, 5) = "" Then
Cells(sor2, 5) = Cells(sor1, 2)
Else
Cells(sor2, 5) = Cells(sor2, 5) & "|" & Cells(sor1, 2)
End If
End If
End If
Next
Next
MsgBox "Kész van", vbInformation, "Értesítés"
End Sub -
#42435
Delila_1
veterán
Nagyzoli27
#42432
Delila_1
veterán
válasz
Nagyzoli27
#42432
üzenetére
Egy rövid makróval megoldható.
Sub Kapcsolodo()
Dim sor1 As Integer, sor2 As Integer, usor1 As Integer, usor2 As Integer
usor1 = Range("A" & Rows.Count).End(xlUp).Row
usor2 = Range("D" & Rows.Count).End(xlUp).Row
For sor2 = 2 To usor2
For sor1 = 2 To usor1
If Cells(sor2, "D") = Cells(sor1, 1) Then
If Cells(sor2, 5) = "" Then
Cells(sor2, 5) = Cells(sor1, 2)
Else
Cells(sor2, 5) = Cells(sor2, 5) & " | " & Cells(sor1, 2)
End If
End If
Next
Next
End Sub
Új hozzászólás Aktív témák
Hirdetés
Fferi50- One mobilszolgáltatások
- Steam, GOG, Epic Store, Humble Store, Xbox PC Game Pass, Origin Access, uPlay+, Apple Arcade felhasználók barátságos izgulós topikja
- Építő/felújító topik
- Revolut
- Windows 11
- Napelem
- Bambu Lab 3D nyomtatók
- Zalaegerszeg és környéke adok-veszek beszélgetek
- Kompakt vízhűtés
- Háztartási gépek
- További aktív témák...
- Assassin's Creed Shadows Collector's Edition PC
- Bontatlan - BATTLEFIELD 1 Collectors Edition - Játékszoftver nélkül
- Eladó Steam kulcsok kedvező áron!
- Sea of Thieves Premium Edition és Egyéb Játékkulcsok.
- Microsoft licencek KIVÉTELES ÁRON AZONNAL - UTALÁSSAL IS AUTOMATIKUS KÉZBESÍTÉS - Windows és Office
- BESZÁMÍTÁS! MSI B550M R7 5800X 32GB DDR4 512GB SSD RX Nitro+ 6700XT 12GB Corsair 4000D ASUS ROG 650W
- BESZÁMÍTÁS! Gigabyte B760M i5 14600KF 32GB DDR4 1TB SSD RX 6700XT 12GB Zalman Z1 Plus Seasonic 650W
- DELL PowerEdge R640 rack szerver - 1xGold 6138 (20c/40t, 2.0/3.7GHz), 64GB RAM,4x1G RJ, HBA330, áfás
- BESZÁMÍTÁS! Gigabyte A620M R5 7500F 32GB DDR5 512GB SSD RX 6700 XT 12GB ZALMAN S3 TG CM 700W
- REFURBISHED - DELL Thunderbolt Dock WD19TBS docking station (210-AZBV)
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: CAMERA-PRO Hungary Kft
Város: Budapest