- Az Oppo Find X8 Ultra lett a legvékonyabb kameramobil
- Apple AirPods Pro (2. generáció) - csiszolt almaságok
- iPhone topik
- One mobilszolgáltatások
- Samsung Galaxy S21 és S21+ - húszra akartak lapot húzni
- 45 wattos vezeték nélküli töltés jön az új iPhone-ba
- Google Pixel topik
- Okosóra és okoskiegészítő topik
- Motorola Razr 60 Ultra - ez a kagyló könnyen megfő
- Xiaomi 13 - felnőni nehéz
-
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
-
Fferi50
Topikgazda
válasz
slashing
#22962
üzenetére
Szia!
Hogy egyikünknek se legyen egyből igaza:
=ÉS(MIN($A2:$D2)=A2;A2<>"")Ezt kell az A-D oszlopra ráhúzni. Mert a legkisebbet keressük a 4 oszlopban - már ha jól értettem.
Ha így írod be a képletet, akkor minden oszlopban saját magára nézve is fogja a cella értelmezni.
Üdv.
-
-
-
Delila_1
veterán
válasz
slashing
#22798
üzenetére
DARAB-bal nem működik, DARAB2-vel is úgy, hogy ahol a képleted üres stringet ad, ott az érvényesítésben (vagy vezérlőben) is lesz egy üres sor. Nem üres a cella, hiszen van benne egy képlet.
=OFSZET(Munka1!$B$2;0;0;1;DARAB2(Munka1!$1:$1))
Szerk.:
Nézd meg a beállításokat. Régebbi verzióban volt rá mód – nem ugrik be, hol –, hogy ahol nulla értéket talált, azt nem jelenítette meg a diagram. -
-
botond187
csendes tag
válasz
slashing
#22781
üzenetére
A cikkszámok ezek:
G-010100014
G-010100102
G-010500578
G-010501010
G-010502019
G-010503031
G-010504042
G-010504006
G-010504123Ezekből figyelmen kívűl kell hagyni ezt, mert ez mindenhol ugyanaz: G-
Ezután jön egy 6 számjegy, amik kategóriáknak a kódszámai, pl: 010100
Ezután jönne maga a termék azonosító száma 3 számjegy pl: 102Legyen a fenti cikkszám az A oszlopban. A mellette levő oszlopban kellene másolni az A oszlop cikkszámait úgy, hogy a számokból olvassa ki, hogy mit.
Pl. ha a kategóriakód 010100 és a termékazonosító 000 és 099 közé esik, akkor rendelje hozzá a következő cikkszámokat: ami G-010504-el kezdődik, és az utolsó 3 szám 000 és 099 közé esik.
Igazából kiegészítő termékek lennének, ezért szeretném ezt létrehozzni, mert így autómata lenne.
Tehát a példa alapján így kéne kinéznie:
A-oszlop
G-010100014B oszlopba ez kerüljön a példa alapján
G-010504006IG-010504042 -
tgumis
tag
válasz
slashing
#22748
üzenetére
hát úgy néz ki mégis igazad van de fkeresnél van valami olyan kikötés hogy sorba kell legyen rendezve a lista ugye? De ha emelkedő sorrendben van akkor rendbe kell mennie ugye? Amúgy igen megértetted köszi.
De azért azért kicsit félek az fkerestől. Ha van más ötletetek akkor osszátok meg. Még egyszer köszi. -
Delila_1
veterán
válasz
slashing
#22737
üzenetére
Laphoz rendeld a makrót.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim perc As Double
Dim szog As Double
If Target.Column = 1 Then
Application.EnableEvents = False
szog = Left(Target, InStr(Target, " "))
perc = Mid(Target, InStr(Target, " "))
Range("D9") = szog + perc / 60
Application.EnableEvents = True
End If
End Sub -
tgumis
tag
válasz
slashing
#22730
üzenetére
Most úgy van megoldva hogy a fő tàblàn szerepelnek a receptek. Amelyik több összetevős ott cellaegyesìtéssel egyesìtve a receptkód és a recept neve külön . Mellette rejtve minden összetevő felsorolva és ha beírok valahovà adagot akkor a rejtett rèszen megjelennek a kiszabat szorozva adag osztva egység tömeg majd a végén az alapanyagok tàblàban a szumha függvény segítségével összeadva.-
Fkeres azért nem jó mert vannak több összetevős receptek és az első talàlat utàn megàll. Az fkérésnél amúgy 1000 szer jobb az index ha függvény kombinàció.
Szòval valami egyszerűbb megoldàs kell mert a mostanival maceràs a képletezés és sok a hibalehetőség. -
-
Delila_1
veterán
válasz
slashing
#22648
üzenetére
A vezérlők eszköztárából kiteszel a lapra egy listboxot. Tervező üzemmódban a tulajdonságoknál a ColumnCount-ot 2-re állítod (két oszlopot mutasson), a Visible-t pedig False-ra.
A makródban a státuszsor kiíratása után beteszed a sorszámot és a fájlnevet, mondjuk az AA és AB oszlopokba.
Cells(loopcount, "AA")=loopcount
Cells(loopcount, "AB")=FilenameKiíratás:
Sheets("Munka1").ListBox1.ListFillRange = "Munka1!AA1: AB" & loopcount
Sheets("Munka1").ListBox1.Visible = True -
Fferi50
Topikgazda
-
Delila_1
veterán
válasz
slashing
#22623
üzenetére
Ímé:
Sub masol()
Dim oszlop As Integer, usor As Long, Uoszlop As Integer, FN As String
Uoszlop = Cells(4, Columns.Count).End(xlToLeft).Column
For oszlop = 2 To Uoszlop
FN = Cells(4, oszlop) & ".xls"
usor = Cells(4, oszlop).End(xlDown).Row
Range(Cells(5, oszlop), Cells(usor, oszlop)).Copy
Workbooks.Open "C:\adatokki\" & FN
Sheets("Data Entry").Activate
usor = Range("D" & Rows.Count).End(xlUp).Row + 1
If usor < 12 Then usor = 12
Range("D" & usor).PasteSpecial xlPasteAll
ActiveWorkbook.Save
ActiveWorkbook.Close
Next
End Sub -
Delila_1
veterán
válasz
slashing
#22616
üzenetére
Nem próbáltam ki!
Sub masol()
Dim O As Integer, usor As Long, oszlop As Integer, FN As String
oszlop = Cells(1, Columns.Count).End(xlToLeft).Column
For O = 2 To oszlop
FN = Cells(1, O) & ".xlsx"
usor = Cells(1, O).End(xlDown).Row
Range(Cells(2, O), Cells(usor, O)).Copy
Workbooks.Add
Range("A1").PasteSpecial
ActiveWorkbook.SaveAs Filename:="C:\adatokki\" & FN
ActiveWorkbook.Close
Next
End Sub -
Delila_1
veterán
válasz
slashing
#22563
üzenetére
Így hirtelen ránézésre az end with fölötti sorban
Workbooks(WBN).Sheets(WS).Cells(6, usor). ...
helyett
Workbooks(WBN).Sheets(WS).Cells(6, uoszlop). ...
kell.Miért emlékeznék?
Még annyit tehetsz bele, hogy az uoszlop megadása után betehetsz egy feltételt.
if uoszlop<4 then uoszlop=4
Ez azt teszi, hogy ha a 6. sorban nincs adat, akkor a D lesz az első oszlop, ahova másolsz. -
Delila_1
veterán
válasz
slashing
#22561
üzenetére
Nem írtad, csak feltételezem, hogy a másolandó adatok a D6 cellától lefelé helyezkednek el.
Sub nn()
Dim Innen As Worksheet, Ide As Worksheet, usorInnen As Long, oszlopIde
Set Innen = Workbooks("Innen.xls").Sheets("ErrolALaprol")
Set Ide = Workbooks("Ide.xls").Sheets("ErreALapra")
usorInnen = Innen.Range("D" & Rows.Count).End(xlUp).Row + 1
oszlopIde = Ide.Cells(6, Columns.Count).End(xlToLeft).Column + 1
Innen.Range("D6:D" & usorInnen).Copy Ide.Cells(6, oszlopIde)
End Sub -
Delila_1
veterán
válasz
slashing
#22554
üzenetére
Most 3 törlendő adatot tettem a tömbbe, a nulladik helytől a másodikig, ezért a ciklus 0-tól 2-ig fut.
Lehet, nem a Te érdemed a cserélős makró, de hogy megtaláltad, feltétlenül az. Mindig csodálom azokat, akik ki tudnak keresni valamit a neten, nekem ez egyáltalán nem megy.
-
Delila_1
veterán
válasz
slashing
#22551
üzenetére
Dim cserelendo, b as Integer
cserelendo = Split("TIME-DISTANCE-Nominal", "-")
For b = 0 To 2
Cells.Replace What:=cserelendo(b), Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
NextA cserelendo egy tömb, amibe a Split-tel beteszed a törlendő adatokat.
A ciklus 1-gyel kevesebb értékig fusson, mint ahány törlendő értéked van, mert a tömb nullától töltődik fel. -
-
mh197
őstag
válasz
slashing
#22516
üzenetére
Igen, ezt ismerem, hogy átkattintok, és így hivatkozom. De próbáld ki ezt akkor, ha ezt követően elmented és bezárod a két fájlt. Utána a mappát másold át valahová márs helyre, amiben ez a két fájl van, pl másik gépre, és más mappába. Na ha ekkor megnyitod a két fájlt, akkor frissíteni kell az elérési utat.. Ezt akarnám valahogy kikerülni, hogy ne kelljen frissíteni.
-
Fferi50
Topikgazda
válasz
slashing
#22401
üzenetére
Szia!
Most láttam a képletedet. Ha 2010-es exceled van, akkor majdnem fele ennyiből megúszhatod a HAHIBA függvény alkalmazásával:
=HAHIBA(BAL(FKERES(W3;Táblázat2;6;0);SZÖVEG.KERES(";";FKERES(W3;Táblázat2;6;0))-1);HAHIBA(BAL(FKERES(W3;Táblázat2;6;0);SZÖVEG.KERES("-";FKERES(W3;Táblázat2;6;0))-1);FKERES(W3;Táblázat2;6))) & " " & HAHIBA(BAL(FKERES(W3;Táblázat2;8;0);SZÖVEG.KERES(";";FKERES(W3;Táblázat2;8;0))-1);HAHIBA(BAL(FKERES(W3;Táblázat2;8;0);SZÖVEG.KERES("-";FKERES(W3;Táblázat2;8;0))-1);FKERES(W3;Táblázat2;8)))Üdv.
-
Mauzes
addikt
válasz
slashing
#22462
üzenetére
Most csak annyit csináltál, hogy az iferror meg row parancsokat magyarra írtad és vessző helyett pontosvesszőt tettél?
Nekem angol nyelvű excel-em van, és a képletet beírva (angol parancsokkal) azt írja, hogy "this function is not valid" és mikor nyomok erre egy OK-t, akkor kijelöli a "filter" parancsot...
-
mdk01
addikt
válasz
slashing
#22421
üzenetére
A kötjelek, alsóvonások mindig vannak a számok között, de mindig máshol(más értéken ha az elejétől számoljuk) és változnak a számok is, hol 2, hol 0,4 szerepel.
Nem egyszerű, én is folózók rajta...cégnél rémlik vmi hasonló függvény sorozat, de arra nem emlékszem az pontosan mit számol, de megnézem jövőhéten. -
Delila_1
veterán
válasz
slashing
#22195
üzenetére
Szívesen.
Igen, a WS változó az aktív lap nevét tárolja, és ezt adja át a Pathname változónak is.
Kiteszed a gombot az első 6120-... lapra, hozzárendeled a ProcessFiles makrót. A gombon a szöveg olyasmi lehet, hogy Adatok bemásolása. Ezt a gombot másolod az összes többi lapra. Bárhonnan indítod, mindig a saját könyvtárából hívja be a fájlokat. -
Delila_1
veterán
válasz
slashing
#22192
üzenetére
A DoWork makró End With fölötti sora legyen
Workbooks(WBN).Sheets(WS).Range("A" & usor).PasteSpecial Paste:=xlPasteAll, Transpose:=True
Szerk.:
Inkább leírom a 2. makrót is.
Sub DoWork(wb As Workbook, WBN, WS)
Dim usor As Long, cell As Range, selectRange As Range
With wb
usor = .Sheets("Munka1").Range("A" & Rows.Count).End(xlUp).Row
For Each cell In .Sheets(1).Range("A3:A" & usor)
If (cell.Value <> "") Then
If selectRange Is Nothing Then
Set selectRange = cell
Else
Set selectRange = Union(cell, selectRange)
End If
End If
Next cell
usor = Workbooks(WBN).Sheets(WS).Range("A" & Rows.Count).End(xlUp).Row + 1
selectRange.Copy
Workbooks(WBN).Sheets(WS).Range("A" & usor).PasteSpecial Paste:=xlPasteAll, Transpose:=True
End With
End Sub -
Delila_1
veterán
válasz
slashing
#22192
üzenetére
Próba nélkül az első makró (nálam most éppen bedöglött az Excel).
Sub ProcessFiles()
Dim Filename, Pathname As String, WBN As String, WS As String
Dim wb As Workbook
Application.ScreenUpdating = False
WBN = ActiveWorkbook.Name
WS = ActiveSheet.Name
Pathname = "C:\teszt\" & WS & "\"
Filename = Dir(Pathname & "*.xlsx")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
DoWork wb, WBN, WS
wb.Close SaveChanges:=True
Filename = Dir()
Loop
Application.ScreenUpdating = True
End SubBármelyik oldalról indítva elméletileg a saját könyvtárából hívja be, és másolja a füzetek adatait.
-
Delila_1
veterán
válasz
slashing
#22185
üzenetére
Akkor ugorj neki újra.
1 db fájlba, különböző lapokra akarod bemásolni több füzet lapjainak a tartalmát?
A gyűjtő füzet lapjait úgy nevezted el, hogy a név egyúttal a mappa neve, ahonnan be akarod gyűjteni az adatokat?Ahonnan másolsz, azok a füzetek hány lapot tartalmaznak?
-
Delila_1
veterán
válasz
slashing
#22183
üzenetére
Legegyszerűbb, ha minden füzetben a másolandó oldalt az első helyre mozgatod. Ekkor a DoWork makróban a
usor = .Sheets("Munka1").Range("A" & Rows.Count).End(xlUp).Row
sor helyett
usor = .Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
kerül, a
Workbooks(WBN).Sheets("6120-1121 PCB OLDAL").Range("A" & usor).PasteSpecial Paste:=xlPasteAll, Transpose:=True
helyett pedig
Workbooks(WBN).Sheets(1).Range("A" & usor).PasteSpecial Paste:=xlPasteAll, Transpose:=True
Az összegző füzetben is első legyen a lap, ahova bemásolod a többi füzetből az adatokat.
-
Delila_1
veterán
válasz
slashing
#22169
üzenetére
Az előbbi makró csak a megnyitott fájl adatainak a másolását oldotta meg. A mostaniban a fájlok megnyitása, és zárása is szerepel.
A Pathname változóban írd át az útvonalat. Nem érdemes az összefűzendő fájlokat és azt, amelyikben összefűzöd, azonos mappában tartani.
Sub ProcessFiles()
Dim Filename, Pathname As String, WBN As String
Dim wb As Workbook
WBN = ActiveWorkbook.Name
Pathname = "F:\Eadat\valami\"
Filename = Dir(Pathname & "*.xls")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
DoWork wb, WBN
wb.Close SaveChanges:=True
Filename = Dir()
Loop
End SubSub DoWork(wb As Workbook, WBN)
Dim usor As Long, cell As Range, selectRange As Range
With wb
usor = .Sheets("Munka1").Range("A" & Rows.Count).End(xlUp).Row
For Each cell In .Sheets(1).Range("A3:A" & usor)
If (cell.Value <> "") Then
If selectRange Is Nothing Then
Set selectRange = cell
Else
Set selectRange = Union(cell, selectRange)
End If
End If
Next cell
usor = Workbooks(WBN).Sheets("mega").Range("A" & Rows.Count).End(xlUp).Row + 1
selectRange.Copy
Workbooks(WBN).Sheets("mega").Range("A" & usor).PasteSpecial Paste:=xlPasteAll, Transpose:=True
End With
End Sub -
Delila_1
veterán
válasz
slashing
#22169
üzenetére
[Sub it()
Dim cell As Range, usor As Long
Dim selectRange As Range
usor = Sheets("Munka1").Range("A" & Rows.Count).End(xlUp).Row
For Each cell In ActiveSheet.Range("A3:A" & usor)
If (cell.Value <> "") Then
If selectRange Is Nothing Then
Set selectRange = cell
Else
Set selectRange = Union(cell, selectRange)
End If
End If
Next cell
usor = Sheets("mega").Range("A" & Rows.Count).End(xlUp).Row + 1
selectRange.Copy
Sheets("mega").Range("A" & usor).PasteSpecial Paste:=xlPasteAll, Transpose:=True
End Sub -
slashing
senior tag
válasz
slashing
#22168
üzenetére
de istenigazából az is tökéletes megoldás nekem ha a mega munkalapra kerül egymás alá.
És akkor a munkafüzeten1-en lenne egy makró indítás gomb a mega lapon meg ott lenne minden fájlból az adat. Ez még jobb is mint a ha külön fájlba menne!faszán össze flood-oltam a fórumot
-
slashing
senior tag
válasz
slashing
#22165
üzenetére
tárgytalan google segített:
Sub ProcessFiles()
Dim Filename, Pathname As String
Dim wb As WorkbookPathname = ActiveWorkbook.Path & "\Files\"
Filename = Dir(Pathname & "*.xls")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
DoWork wb
wb.Close SaveChanges:=True
Filename = Dir()
Loop
End SubSub DoWork(wb As Workbook)
With wb
'Do your work here
.Worksheets(1).Range("A1").Value = "Hello World!"
End With
End Sub -
Louro
őstag
válasz
slashing
#22001
üzenetére
Én is az összesítőn oldanám meg. Lenne két mező: Mettől és Meddig. Az összegzés pedig a két paraméter között sheet-eket összesítené. (Elgondolkodtam a megvalósításán és valamiért a makró nekem használhatóbb.)
De, ha makró, akkor ugyanúgy kellene a Mettől Meddig mezők és a ciklus a paraméterben megadott értékek között futna le.
Összegző sheet-en lenne valahol a táblázat nagyon végén vagy az első oszlopban lenne.Makróban ennyi lenne:
Dim Mettol As Integer, Meddig As IntegerActiveWorkbook.Worksheets("Osszegzes").Select
Mettol = Cells(1, 1)
Meddig = Cells(2, 1)If Mettol > Meddig Then
MsgBox "Nagyobb a Mettől mező, mint a Meddig."
Else
For i = Mettol To Meddig
itt van az összeadás
Next
End If -
-
Delila_1
veterán
válasz
slashing
#21921
üzenetére
Az E1 cella tartalmazza a mindenkori utolsó sor értékét.
Előfordul, hogy 1-2 sor cellái üresen maradnak a táblázat fölött, akkor az oszlop üres celláinak a számát add hozzá az E1 képletéhez. Ha 2 üres cella van az A oszlop tetején, az E1 képlete =darab2(a:a)+2
Figyelem! Ha üres cellák is vannak az A oszlopban, az E1 nem az utolsó kitöltött cella sorszámát adja!
-
Delila_1
veterán
válasz
slashing
#21752
üzenetére
Nem értettelek félre, csak javasoltam egy egyszerű megoldást, amit autoszűrővel hajthatsz végre.
Irányított szűrővel is megkaphatnád az eredményt, de ahhoz is minden sorban kellene szerepelnie a sorszámnak. Az Excel módot ad a cellák összevonására, de sok esetben – mint a példádban is – nem tudja helyesen kezelni.Átlátható marad a táblázatod, ha ügyesen adsz feltételes formázást. Az A3 cellától lefelé kell kijelölnöd az A oszlopban kitöltött tartományt, miután megszüntetted a cellák összevonását.
Az egyik képlet a formátumban =A3=A2, itt a karakter színét kell beállítanod a háttér színére, a feltett kép szerint fehérre.
A másik képlet =A3<>A2, ennél egy felső szegélyt kell beállítanod..
A B:C tartomány legyen kívül-belül szegélyezve. Az A oszlop hátterét fehérre állítva a cellarácsok sem zavarják a képet, de a beállításoknál is megszüntetheted a cellarácsok megjelenítését.
Ilyen lesz:
, szerintem maradhat a target.column.
![;]](http://cdn.rios.hu/dl/s/v1.gif)
Új hozzászólás Aktív témák
Hirdetés
Fferi50- RAM topik
- Linux kezdőknek
- Arch Linux
- Milyen digitális videókamerát?
- Vigneau interaktív lokálblogja
- NVIDIA GeForce RTX 5070 / 5070 Ti (GB205 / 203)
- Az Oppo Find X8 Ultra lett a legvékonyabb kameramobil
- Mozilla Firefox
- Eredeti játékok OFF topik
- Telekom otthoni szolgáltatások (TV, internet, telefon)
- További aktív témák...
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Eladó steam/ubisoft/EA/stb. kulcsok Bank/Revolut/Wise (EUR, USD, crypto OK)
- Bontatlan - BATTLEFIELD 1 Collectors Edition - Játékszoftver nélkül
- Microsoft licencek KIVÉTELES ÁRON AZONNAL - UTALÁSSAL IS AUTOMATIKUS KÉZBESÍTÉS - Windows és Office
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Nvidia Quadro P400/ P600/ P620/ P1000/ T400/ T600/ T1000 - Low profile (LP) + RTX A2000 6/12Gb
- Bomba ár! HP ZBook Studio G5 - i9-9980H I 32GB I 1TSSD I Nvidia I 15,6" FHD I Cam I W11 I Gar
- Telefon felváráslás!! iPhone 15/iPhone 15 Plus/iPhone 15 Pro/iPhone 15 Pro Max
- Felújított számítógépek/merevlemezek Számlával, garanciával! Ingyen Foxpost!
- Bomba ár! Fujitsu LifeBook U758 - i5-8GEN I 8GB I 256GB SSD I HDMI I 15,6" FHD I W11 I Garancia!
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: CAMERA-PRO Hungary Kft
Város: Budapest