- Samsung Galaxy S25 Ultra - titán keret, acélos teljesítmény
- Milyen okostelefont vegyek?
- Honor Magic6 Pro - kör közepén számok
- One mobilszolgáltatások
- iPhone topik
- Olcsó Galaxyk telepíthetik a One UI 7-et
- Milyen GPS-t vegyek?
- Samsung Galaxy A56 - megbízható középszerűség
- Samsung Galaxy S22 Ultra - na, kinél van toll?
- Google Pixel topik
-
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
-
Louro
őstag
válasz
Fferi50
#26183
üzenetére
Kreáltam magamnak egy feladatot és megnéztem ezt a megnyitásmentes megoldást és nekem az a baj, hogy ahhoz, hogy befrissüljön felugrik egy párbeszédablak, hogy tallózzam be a forrást. Az oké, hogy ha Esc-elem, akkor frissül, de nálam lehet a bibi?
Kódrészlet.
WB_Source_file = "D:\VB_Test\" & Year(Now - 30) & "\" & actual_month & "\" & code & ".xlsx"
Filename = Dir(WB_Source_file)
If Filename = "" Then
GoTo Nem_létezik_a_forrása
Else
For k = 1 To 3
Sheets("Összesített_eredmény").Cells(j, 3 + actual_month).Formula = _
"=HAHIBA('[" & Filename & "]TOTAL'!V29,""-"")"
Sheets("Kommunikáció").Cells(j, 3 + actual_month).Formula = _
"=HAHIBA('[" & Filename & "]TOTAL'!V10,""-"")"
Sheets("Mozgás").Cells(j, 3 + actual_month).Formula = _
"=HAHIBA('[" & Filename & "]TOTAL'!V18,""-"")"Rosszul hivatkozom be a másik munkafüzetet?
@26199: Köszi. Pont a hétvégén futottam bele ebbe a "másolás a célba" esetbe. Csak még nem gyakoroltam be, így ezért nem alkalmazom.
-
Fferi50
Topikgazda
Szia!
Ebben a pár sorban van egy kis ellentmondás:
Workbooks.Open(Filename)
'Itt jön a másolgatás.
Range("B2").Select
Selection.Copy
Workbooks("Master.xlsx").Worksheets("Sheet1").Range(Cells(ActiveSheet.Usedrange.Rows.Count,1)).PasteSpecial xlPasteValues
A munkafüzet megnyitása után a megnyitott munkafüzet lesz aktív, eddig rendben.
A Select nélkül is lehet másolni: Range("B2").Copy
A bibi itt van szerintem:
Workbooks("Master.xlsx").Worksheets("Sheet1").Range(Cells(ActiveSheet.Usedrange.Rows.Count,1)).PasteSpecial xlPasteValues
mivel az ActiveSheet továbbra is az, ahonnan a másolást csinálod, azaz a megnyitott munkafüzet aktív munkalapja!
Helyette a Master fájl "Sheet1" munkalapjára kellene itt is hivatkozni. Ráadásul minden egyes file adatát ugyanabba a sorba (usedrange.rows.count) fogja beírni - azaz csak az utolsó fájl adata marad meg.
Ezen kívül a másolást lehet direktbe is csinálni:
Range("B2").Copy Destination:=Workbooks("Master.xlsx").Worksheets("Sheet1").Cells(Workbooks("Master.xlsx").Worksheets("Sheet1").UsedRange.Rows.Count + 1, 1)Természetesen a többi cella másolásánál már a UsedRange.Rows.Count kell.
Ha viszont csak az értéket szeretnéd átvenni, akkor működik ez is:
Workbooks("Master.xlsx").Worksheets("Sheet1").Cells(Workbooks("Master.xlsx").Worksheets("Sheet1").UsedRange.Rows.Count + 1, 1).Value=Range("B2").ValueÜdv.
-
Delila_1
veterán
válasz
lokos19
#26192
üzenetére
For Each cell In Range(ter)
If cell.Interior.ColorIndex = 6 Then Cells(5, 5) =Cells(5, 5) +cell.value 'sárga
If cell.Interior.ColorIndex = 5 Then Cells(5, 12) =Cells(5, 12) +cell.value 'kék
If cell.Interior.ColorIndex = 3 Then Cells(5, 15) =Cells(5, 15) +cell.value 'piros
Next -
lokos19
csendes tag
Sziasztok!
kellene egy kis segítség Excelhez, meg kellene írni a programot úgy, hogy ne csak 6-os színre sárgára nézze a cellákat hanem 5 kék színre is és azt egy másik cellában összegezze. mondjuk a Cells(5, 12)
Sub szines()
Dim ter As String
Dim cell As Object
Dim össz As Variant
ter = "A14:V60"For Each cell In Range(ter)
If cell.Interior.ColorIndex = 6 Then össz = össz + cell.Value
Next
Cells(5, 5) = összEnd Sub
THX!
-
-
-
Hoorus
őstag
Sziasztok!
Adott egy több ezer soros táblázat, mely egyik oszlopából azokat a sorokat kellene leszűrni, amelyek ismétlődnek. Pontosabban, csak azok a sorok maradjanak a táblázatban, amelyek többször elő fordulnak, az egyedi sorokat szeretném törölni belőle..
Van erre valamilyen megoldás?
Köszönöm
-
Fferi50
Topikgazda
válasz
alevan
#26181
üzenetére
Szia!
A következő megoldást javaslom:
Sub fajlmasolo()
' A makró legyen a Master fileban, amit makróbarát fájlként kell a művelet elindítása előtt elmenteni!
' Így a Master.xlsm legyen a forrásfájlokkal egy mappában, ez a mappa mindegy, hogy hol van!.
Dim Filename As String, Pathname As String,xx as Double
Activesheet.Usedrange.Clear ' a munkalap tartalmát kitöröljük
'Hol vannak a fájlok
Pathname = ActiveWorkbook.Path
Filename = Dir(Pathname & "*.xlsx") 'Ha régi formátumban vannak, akkor .xls-re írd át.
xx = 1 'ez az első fájl helye - az első oszlop
'Menjen végig minden fájlon
Do While Len(Filename) > 0
'NEM KELL Megnyitni a forrást!!!
Cells(1, xx).Formula = "='[" & Filename & "]Sheet1'!B2" 'Sheet1 helyére azt a munkalapnevet kell írnod, ahol az adatok vannak a forrásfájlban.
Cells(2, xx).Formula = "='[" & Filename & "]Sheet1'!C8"
Cells(3, xx).Formula = "='[" & Filename & "]Sheet1'!B15"
' itt folytatod a kitöltést a fentiek szerint
xx = xx + 1 ' vesszük a következő oszlopba
Filename = Dir() 'a következő fájlt
Loop
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value ' a képleteket átváltjuk értékre
MsgBox "A másolásnak vége!", vbInformation
End SubMakrót az Alt+F11 után "feltűnő" VBA ablakba tudsz másolni. A menüből ki kell választanod az Insert - Module opciót. Ezután tudod a modulba bemásolni.
A forrásfájlokat utána kitörölheted - vagy az újakkal felülírhatod és ismételten lefuttatod a makrót.
Üdv.
-
Louro
őstag
válasz
alevan
#26181
üzenetére
Szia,
egy gyors, esti fusimunka, de hátha használható. Ha nem megy a makrózás, akkor bocsi. Feltételezek egy kisebb hozzáértést
Főleg az adatmásolásnál lehet hasznos, bár pici logikával hamar megvan, hogy hogyan lehet A-ból B-be másolgatni.A lentit direkt úgy csináltam, hogy a forrásokat kimented egy mappába, így az eredetik érintetlenek maradnak. A fájlokat át se kell nevezni. A lényeg, hogy .xlsx legyen a kiterjesztésük. Azokat mind bedolgozza.
SUB fajlfeldolgozo()
'A Master.xlsx legyen az asztalon.
'A forrásfájlokat másold az Asztal/Forrás mappába ;)
'Így nem kell aggódni, ha 1001 forrás van.
Dim Filename, Pathname As String
Dim SourceWorkbook As Workbook
Dim LeadFinalMsgBox As Boolean
'Hol vannak a fájlok
Pathname = ActiveWorkbook.Path & "\Forrás\"
'Ha régi formátumban vannak, akkor .xls-re írd át.
Filename = Dir(Pathname & "*.xlsx")
'Menjen végig minden fájlon
Do While Len(Filename) > 0
'Megnyitni a forrást
Workbooks.Open(Filename)
'Itt jön a másolgatás.
Range("B2").Select
Selection.Copy
Workbooks("Master.xlsx").Worksheets("Sheet1").Range(Cells(ActiveSheet.Usedrange.Rows.Count,1)).PasteSpecial xlPasteValues
Range("C8").Select
Selection.Copy
Workbooks("Master.xlsx").Worksheets("Sheet1").Range(Cells(ActiveSheet.Usedrange.Rows.Count,2)).PasteSpecial xlPasteValues
'itt akár elegánsan ciklussal is meglehetne csinálni.
'Forrásfájl törlése
Kill Pathname & Filename
'Hol vannak a fájlok
Filename = Dir(Pathname & "*.xlsx")
Loop
End SUB -
alevan
őstag
Sziasztok. Nagy problémámmal állok elétek.
Adott sok sok excel file (összesen többszáz). Mindegyiknek a neve egy szám (0-tól 1000ig). Mindegyikből kell ugyanazokból a cellákból adat. Magyarán mindegyik excel fileból kell pl. a B2 cella tartalma, a C8 tartalma, a B15 tartalma, stb..
Namármost nekem ezeket a cellatartalmakat egy nagy excel fileba kell tennem. Vagyis, a "mester" excelben az első sorban az 1.xlsx fájlból az a B2 cella tartalma legyen az A1 cellában. A C8 cella tartalma az A2 cellában, stb.
Megcsinálnám kézzel, ha nem összesen 25 változót kellene minden excel fájlból átmásolni és ezek után ezt havonta megcsinálni.
Van-e valami megoldás arra, hogy ezt az excel automatikusan megcsinálja.
Pl. ha a "mester" xlsx fájl és a sok számozott xlsx fájl egy mappába vannak, akkor automatikusan minden változót (hisz ugyan az a koordinátája, csak más fájl) szépen sorban betesz nekem a "mester" xlsx-be?
-
hhheni
tag
válasz
Des1gnR
#26169
üzenetére
ha nem szereted a reguláris kifejezéseket, akkor lökd be wordbe:
csere 2 db enter -> "duplaenter"
csere enter -> vessző (vagy pontosvessző)
csere "duplaenter" -> enter
és már lehet is importálni
ha a "sorvégeken" nem enter van, hanem pl. shift-enter, akkor értelemszerűen arra végzed el a cseréket
ha az árával számolni is szeretnél, akkor érdemes az importáláskor a :-ot is megadnod határolójelként -
Louro
őstag
Uh, jobban megnézve a kódot szerintem csak a módosítás dátumával számol.
Mivel minden kódsor különböző időpontban fut, gondolom elég futtatásonként egyszer megnézni az időpontot. Ha kell, akkor pedig kérd le "nyugodtan" a rendszeridőt.
Na nemsokára lejár a munkaidőm....Még azt kellene megnézni, hogy magában a táblázatban van -e parancs, amivel le tudod kérni az időpontot, mint Excel esetén a =TODAY() . Ha van, akkor esetleg egy cellába tárolni :$ -
Louro
őstag
Hát elég gagyi megoldást találtam a gugli segítségével, de jobb, mint a semmi. Ha sűrűn kell dátum, - amit nem javaslok, mert lassít -, akkor egy változóba tedd ki egyszer és azzal dolgozz.
Forrás:[link]
Simple macro
=
Timestamp in A1 in Sheet1
=
Code:
Sub timestamp
oDoc = thiscomponent
oSheet = oDoc.Sheets(0)
oCell = oSheet.getCellRangeByName("A1")
oCell.String = oDoc.DocumentInfo.ModifyDate.Day _
& "/" & oDoc.DocumentInfo.ModifyDate.Month _
& "/" & oDoc.DocumentInfo.ModifyDate.Year _
& " " & oDoc.DocumentInfo.ModifyDate.Hours _
& ":" & oDoc.DocumentInfo.ModifyDate.Minutes
End Sub -
Louro
őstag
válasz
Des1gnR
#26169
üzenetére
Ha jól értem transzponálni szeretnél?
Pl.:
Élelmiszer_____________Élelmiszer
Édesség______________Édesség
Belvita jóreggelt________Orbit eper
Nettó ár______________Nettó árVagy
Élelmiszer______Édesség_____Belvita_____Nettó ár
Élelmiszer______Édesség_____Orbit_______Nettó ár(Az alsóvonások csak az olvashatóság miatt vannak
)Ha minden termék 4 adatból áll, akkor szerencsések vagyunk, mert ciklussal gyorsan feldolgozhatóak.
Csak a kérdés, hogy a fentiből melyik kell.Ha a 2., akkor
Sub darabolo()
Dim LastRow As Integer
LastRow = ActiveSheet.UsedRange.Rows.Count
For i = 1 To LastRow Step 5
For j = 0 To 3
'Vegye ki az első négy sort és illessze be pár oszloppal odébb.
Cells(i + j, 1).Select
Selection.Copy
Cells(i, 3 + j).PasteSpecial xlPasteValues
Next
'Az elválasztó sor miatt ugrok 5-öt.
Next
End Sub -
be.cool
csendes tag
Sziasztok!
Van egy markom ami azt csinálja,hogy egy adott cellába beírja az aktuális munkalap nevét, viszont nekem fordítva kéne,hogy egy adott cella alapján nevezze el a munkalapot.
Tudnátok ebben segíteni?Sub test()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Range("I7") = ws.Name
Next
End Sub -
Des1gnR
őstag
Sziasztok!
Van egy szöveges állományom amelyben termékek vannak felsorolva:
Élelmiszer
Édesség
Belvita jóreggelt 50g mézzel-mogyoróval
Nettó ár: 83 FtÉlelmiszer
Édesség
Orbit Eper 14g.
Nettó ár: 78 FtA termékek csak egyetlen üres sorral vannak elválasztva. Ezt szeretném úgy excelbe importálni, hogy minden termék új sorba kerüljön és a terméktulajdonságok külön oszlopokba.
Van ötletetek?
-
Fferi50
Topikgazda
válasz
bteebi
#26167
üzenetére
Szia!
Egy apróság van benne. A fajlnev változód a megnyitott fájl teljes nevét tartalmazza és így nem találja meg a megnyitott fájlok között, mert ott viszont csak a rövid név szerepel.
Ezért be kell egy sort iktatni:
End If
fajlnev=activeworkbook.name ' ezt kell beszúrni
For adat = 1 To 10Szerintem így már mennie kell. (De a szövegfeldolgozást továbbra sem értem, hiszen egyszer már megbeszéltük, hogy a számot nem lehet szövegfüggvénnyel darabolni.)
Üdv.
-
bteebi
veterán
válasz
Fferi50
#26166
üzenetére
Szia!
Közben elég sokféleképp próbálkoztam. A jelenlegi változatnál "Subscript out of range" hibaüzenetet dob ennél a sornál:
cellap.Cells(19 + 2 * adat, oszlop) = Left(Workbooks(fajlnev).Sheets("Sheet1").Cells(36 + 2 * (adat - 1), 16), _
Len(Workbooks(fajlnev).Sheets("Sheet1").Cells(36 + 2 * (adat - 1), 16) - 1))Sub masol()
Set cellap = ThisWorkbook.ActiveSheet
Set ablak = Application.FileDialog(msoFileDialogOpen)
ablak.Filters.Clear
ablak.Filters.Add "Excel fájlok", "*.xls, *.xlsx, *.xlsm"
ablak.Filters.Add "Excel 2003 worksheet (.xls)", "*.xls"
ablak.Filters.Add "Excel 2010 worksheet (.xlsx)", "*.xlsx"
ablak.Filters.Add "Excel makró (.xlsm)", "*.xlsm"
ablak.FilterIndex = 1
FileChosen = ablak.Show
ablak.Title = "Válaszd ki a file-t"
ablak.InitialFileName = ThisWorkbook.Path
ablak.InitialView = msoFileDialogViewList
If FileChosen = -1 Then
fajlnev = ablak.SelectedItems(1)
Workbooks.Open (fajlnev)
Else: Exit Sub
End If
For adat = 1 To 10
For oszlop = 2 To 10 Step 4
cellap.Cells(19 + 2 * adat, oszlop) = Left(Workbooks(fajlnev).Sheets("Sheet1").Cells(36 + 2 * (adat - 1), 16), _
Len(Workbooks(fajlnev).Sheets("Sheet1").Cells(36 + 2 * (adat - 1), 16) - 1))
cellap.Cells(19 + 2 * adat, oszlop) = cellap.Cells(19 + 2 * adat, oszlop) * 1000
cellap.Cells(19 + 2 * adat, oszlop).NumberFormat = "0"
Next oszlop
Next adat
Workbooks(fajlnev).Close savechanges:=False
End SubHa az End If az utolsó előtti sorban van, akkor lefut a kód, csak nem csinál semmit; nem másol és nem zárja be a megnyitott file-t. A Workbooks(fajlnev) helyett próbálkoztam ActiveWorkbook-kal is, de úgy se ment, akkor "Type mismatch" hibaüzenetet ad.
-
Fferi50
Topikgazda
válasz
bteebi
#26165
üzenetére
Szia!
Milyen hibát ír ki? Szerintem továbbra is az a baj, hogy nem szövegformátumból akarsz szöveget kivágni a left és len függvényekkel. Ez mire lenne jó?
De a fajlnev is okozhat problémát, mivel az egy szöveges (string) változó és nem objektum.
Ezért így kell használni Workbooks(fajlnev).Sheets("Sheet1"), de a szituációból kiindulva írhatod így is Activeworkbook.Sheets("Sheet1") (mivel megnyitás után ez lesz az aktív munkafüzet).A munkafüzet bezárása is hasonló: Workbooks(fajlnev).Close Savechanges:=False ez utóbbi paraméter alapján nem menti a változásokat és nem is kérdez rá, hogy szeretnéd-e menteni (nem is kell, hiszen a forrásfájlt nem változtatod).
Üdv.
-
bteebi
veterán
válasz
Fferi50
#26163
üzenetére
Szia!
"Ez azt jelenti, hogy mindig van a szám után egy betű és a formátum szöveg?"
Basszus, igazad van (ebben is)!
Minden bizonnyal emiatt nem ment a szorzás, mert az eredeti cella szöveg formátumú volt (vagyis általános). Viszont valamiért az adatmásolás továbbra sem megy. Szerintem itt van a probléma, valószínűleg a "fajlnev" (vagy épp a "cellap") miatt:Set cellap = ThisWorkbook.ActiveSheet
...
cellap.Cells(19 + 2 * adat, oszlop) = Left(fajlnev.Sheets("Sheet1").Cells(36 + 2 * (adat - 1), 16), Len(fajlnev.Sheets("Sheet1").Cells(36 + 2 * (adat - 1), 16) - 1))A végén pedig szeretném bezárni a megnyitott file-t, de a Workbooks.Close (fajlnev) paranccsal nem megy, pedig a Workbooks.Open (fajlnev) parancsra megnyitja
. -
Fferi50
Topikgazda
válasz
bteebi
#26162
üzenetére
Szia!
Az világos, hogy honnan szeretnél másolni, az viszont nem egészen, hogy hova.
Mert a "forrás" munkafüzet megnyitása után az abban levő munkalap válik aktívvá, tehát az itt
" For oszlop = 2 To 10 Step 4
'ebben a sorban valószínűleg több hiba is van:
ActiveSheet.Cells(19 + 2 * adat, oszlop) = 1000 * (Left(fajlnev.Sheets("Sheet1").Cells(36 + 2 * (adat - 1), 16), Len(fajlnev.Sheets("Sheet1").Cells(36 + 2 * (adat - 1), 16) - 1)))
ActiveSheet.Cells(19 + 2 * adat, oszlop).NumberFormat = "0"
Next oszlop"
hivatkozott Activesheet sajnos a forrás fájlodban van.Tehát ebben az esetben neked nem a forrás fájl hivatkozással van problémád, hanem a cél fájl hivatkozásával.
Ezt pedig úgy tudod megoldani, hogy az "eredeti" munkafüzeted kitöltendő munkalapját (amiből a többit megnyitod), egy változóhoz rendeled mielőtt még egy másik fájlt megnyitnál (pl.Set cellap=activesheet), mivel most még az az aktív munkalap.
Ezek után a számolás: cellap.cells(19+2*adat,oszlop) -ra kell hogy hivatkozzon és persze akkor fajlnev.sheets("Sheet1").cells helyett maradhat az Activesheet.cells."az eredeti adatok általános formátuma pl. "3.2k"" Ez azt jelenti, hogy mindig van a szám után egy betű és a formátum szöveg?
Ha igy van, akkor a használható a replace függvény is: replace(activesheet.cells(36+2*(adat-1),16),right(activesheet.cells(36+2*(adat-1),16),1),"").
Viszont a "beszúrt" programsorból úgy látom, az eredeti érték számformátum, ezért működik a közvetlen szorzás 1000-el, vagyis nem kell semmilyen levágás, átalakítás!Még valami: ahol Activesheet.Cells van, ott az Activesheet elhagyható, mert az az alapértelmezés.
Üdv.
-
bteebi
veterán
Sziasztok!
Van egy file-om egy modulban lévő makróval. A file különböző - de megegyező struktúrájú - lapjaira szeretnék más Excel file-okból adatokat bemásolni. A másolandó adatokon minimális változtatást végeznék: az eredeti adatok általános formátuma pl. "3.2k", ezt - az utolsó karakter levágása után - felszorzom 1000-rel, és azt szeretném bemásolni, a számformátumot "0"-ra állítva.
Összességében egy dialógusablakkal szeretném megnyitni az adatforrásként szolgáló file-t, viszont nem tudom, hogy hogyan kell(ene) meghivatkozni ahhoz, hogy menjen a másolás.
A jelenlegi makró:
Sub kitoltes()
Dim ablak As FileDialog, fajlnev As String, FileChosen As Integer
Set ablak = Application.FileDialog(msoFileDialogOpen)
FileChosen = ablak.Show
ablak.Title = "Válaszd ki az importálandó file-t"
ablak.InitialFileName = ActiveWorkbook.Path
ablak.InitialView = msoFileDialogViewList
ablak.Filters.Clear
ablak.Filters.Add "Excel 2003 worksheet", "*.xls"
ablak.Filters.Add "Excel 2010 worksheet", "*.xlsx"
ablak.Filters.Add "Excel makró", "*.xlsm"
ablak.FilterIndex = 1
If FileChosen = -1 Then
fajlnev = ablak.SelectedItems(1)
Workbooks.Open (fajlnev)
Else: Exit Sub
End If
Dim adat As Integer, oszlop As Integer
For adat = 1 To 10
For oszlop = 2 To 10 Step 4
'ebben a sorban valószínűleg több hiba is van:
ActiveSheet.Cells(19 + 2 * adat, oszlop) = 1000 * (Left(fajlnev.Sheets("Sheet1").Cells(36 + 2 * (adat - 1), 16), Len(fajlnev.Sheets("Sheet1").Cells(36 + 2 * (adat - 1), 16) - 1)))
ActiveSheet.Cells(19 + 2 * adat, oszlop).NumberFormat = "0"
Next oszlop
Next adat
End SubHa benne van az 1000-rel való szorzás, akkor "Type mismatch" hibát dob, ezért jobb híján beszúrtam egy plusz sort, így már legalább az a része működik:
ActiveSheet.Cells(19 + 2 * adat, oszlop) = ActiveSheet.Cells(19 + 2 * adat, oszlop) * 1000Tudnátok segíteni a hibák kijavításában? Előre is köszönöm!
-
hhheni
tag
válasz
Delila_1
#26159
üzenetére
most végignéztem a videót, én ilyesmit 2:00 körül találtam, az viszont - az ő szavával élve - az "autofilterre" vonatkozik, és én úgy gondolom, hogy ebben igaza is van: autoszűrő esetén én csak a saját oszlopára vonatkozó feltételeket tudok megadni
irányított szűrővel persze pontosan úgy van, ahogy mutattad
-
Fferi50
Topikgazda
válasz
Delila_1
#26155
üzenetére
Szia!
Most nekem is összejött. Szerintem az a "siker kulcsa", hogy "simán" csak a kifejezést kell beírni képletként, azaz egyenlőségjellel kezdve. Ekkor megjelenik a kifejezés eredménye a kritérium cellában. (Tehát pl. =B2=C2 - ami igaz/hamis -ként jelenik meg- és nem ="=B2=C2", ami =B2=C2 -ként jelenik meg a cellában.)
Üdv.
(Az a szép az ilyen fórumokban, hogy mindig tanul az ember valami újat és hasznosat.)
-
hhheni
tag
válasz
Fferi50
#26150
üzenetére
sziasztok
nem úgy tűnik, hogy ez csak nálam működne, rákerestem egy picit:
[link]
213. oldalon, "képlet" és "logikai"[link]
"felt_1" (itt egyébként megtaláltam arra a kérdésre a megoldást, amelyikben Delila segített)ugyanez videón (itt van egy "felt_2" is):
[link][link]
65. oldal, a hozzá tartozó példa megoldással együtt:[link]
(itt üresen hagyja, de kitöltve is működik) -
Delila_1
veterán
válasz
Fferi50
#26150
üzenetére
Van táblázat a 2003-ban, sőt előtte is, csak ott listának nevezték.
Eddig úgy tudtam, az a lényeg ennél a szűrésnél, hogy megegyezzenek a mezőcímek, de látod, Hhheninél összejött.
"...úgy tudtam megoldani, hogy fölvettem egy "többet" nevű fiktív mezőt, alá d2<k2, és tökéletesen működik"
Nálam az ab.darab2(...) sem jött így össze.
-
-
Delila_1
veterán
Rosszul írtam a két oszlop formátumát.
A G és H oszlop formátuma
(p):mm, jobbra behúzva, behúzás 1.
A szögletes zárójelek nélkül nem mutatná az eltelt órákat a két időpont között. Ezzel igen, percbe átszámolva.Szerk.: a szögletes zárójelet a fórummotor lekerekíti, de a szögletes kell.
-
Delila_1
veterán
A kezdés idejét a rajzszám beírásához rendeltem. Ha az A-hoz is beírnám, akkor eltelik némi idő (pláne, ha közben az adatrögzítő megiszik egy kávét) a rendelés bevitele után, és úgyis felülírná az egyszer már beírt kezdést.
A D, G, és H oszlop megadását is csak az F-hez kötöttem, nincs értelme az E-hez is megadni.
A G és H oszlop formátuma p:mm, jobbra behúzva, behúzás 1.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Target.Column = 2 Then Cells(Target.Row, "C") = Now
If Target.Column = 6 Then
Cells(Target.Row, "D") = Now
Cells(Target.Row, "G") = Cells(Target.Row, "D") - Cells(Target.Row, "C")
Cells(Target.Row, "H") = Cells(Target.Row, "G") / Cells(Target.Row, "F")
End If
End Sub -
Locsi
senior tag
Akkor induljunk. A, vagy B oszlop kitöltésekor a C oszlopba kerüljön be a kezdési idő, dátum, óra, perc. Ekkor elindul a az alkatrész gyártása, és ha elkészült, akkor a E, vagy F oszlop kitöltésekor kerüljön be a D oszlopba befejezési idő, dátum, óra, perc. A D oszlop, és a C oszlop különbsége kerüljön be G oszlopba óra, perc, másodperc pontossággal, a H oszlopba pedig kerüljön be a G oszlop osztva F oszlop, szintén óra, perc, másodperc pontossággal, és ezt a műveletet végezze el minden sor kitöltésekor. Remélem érthető voltam. Köszönöm a segítséget.
-
Delila_1
veterán
Induljunk el a kályhától.
Mikor mit csináljon a makró?Beírod a rendelés számát, majd a rajzszámot. Ekkor írja be a kezdés idejét a C-be?
Mikor írja be a befejezés idejét a D-be? Mikor az F-ben megadod a legyártott darabok számát?A G2 képlete =D2-C2 legyen, percben megadva, és ebből számolja ki a H a darabidőt? Ezt a darabszám megadásakor (F) végezheti.
-
hhheni
tag
válasz
Delila_1
#26135
üzenetére
így van, önmagában ez egy jó megoldás, de ha ez egy összetettebb feltételrendszer része, akkor már nem igazán használható
pedig a szűrés is ugyanígy működik, azt függvénnyel elég körülményes megoldani
az eredeti kérdésre adott válaszodat mindenesetre még egyszer köszönöm, sokat segítettél vele!
-
Louro
őstag
Hát erre jó az én részem. De mondjuk lehet annyit változtatnék, hogy a makrót betenném gyorsbillentyűre vagy egy gombot tennék ki a munkalapra, ami által újra számolná a sorokat.
Jah és Delila megoldása pedig elegánsabb. Szóval jónak kell lennie. Hisz összidőre egyszerű különbségképzéssel, az egy darabra jutó átlagidő pedig osztással.
De lehet ebéd utána kóma miatt félreértettem, de majd jönnek még páran és segítenek.
-
Locsi
senior tag
Hogy érthetőbb legyen, amit evvel "Hogy lehetne ennél azt megcsinálni, hogy a két kitöltött oszlopból (D-C) kiszámolja a az eltelt időkülönbséget (2015.03.20 8:55:35 - 2015.03.20 8:54:33) azt beírja a G oszlopba, és ezt elossza az F oszlopban lévő értékkel, az meg beírja a H oszlopba." akarok, megpróbálom egy képpel érthetővé tenni. Amúgy melóhelyen lenne a termelést követő gépnapló, a papírt elkerülendő.
-
hhheni
tag
válasz
Delila_1
#26129
üzenetére
nahát, akkor csak közeledünk az egyetértés felé...
ez a "többet" ugyanis pontosan ilyen mező: beírtam a kritériumtáblába, de az eredeti táblában nem szerepelt, viszont pontosan erre szűr az irányított-, vagy speciális szűrő, ahogy az általad is jónak ítélt megoldásban hibátlanul működik
úgy látszik, átsiklottál a 26124-esben írott szövegen: nem veszem fel sehová, ez csak a kritériumtáblában létezik, ezért voltam bátor fiktívnek nevezni
de ha csupán az én bölcsészagyammal van a baj, akkor csak szólj...
-
Delila_1
veterán
válasz
hhheni
#26128
üzenetére
Fiktívnek azt nevezném, amit beírsz a kritériumtáblába, de az eredeti táblában nem szerepel. Erre nem tud szűrni az irányított-, vagy speciális szűrő.
Ha az eredeti táblába veszel fel egy új oszlopot, ahol bizonyos számításokat, összehasonlításokat végzel, az egy segédoszlop, része lesz a táblázatodnak, lehet rá szűrni.
Csakis a fiktív elnevezéssel nem értek egyet.
-
hhheni
tag
válasz
Delila_1
#26127
üzenetére
én nem szeretném, ha a beszélgetésünk "csajos marakodássá" fajulna, annál ismeretlenül is sokkal jobban tisztellek a tudásodért meg a sok száz itteni fórumozónak nyújtott folyamatos segítségedért, de nagyon nem értem az "A 26112-es hsz szerint mégis meg lehet oldani a táblázat saját mezőivel." szövegedet...
de ha ezt nem vonatkoztattad a "fiktív mezős" esetre, akkor már csöndben is maradtam, csak így nem igazán értem :-(
a szerkesztett részedhez: bizony fiktív, mert az adatbázisnak nincs ilyen nevű mezője, tehát segédoszlopról sem beszélhetünk
-
hhheni
tag
válasz
Delila_1
#26125
üzenetére
én nyilván nem vagyok olyan képzett, mint te, de azt hiszem, most félreértettél valamit: én arról nem állítottam, hogy nem lehet másképp megoldani, csak annyit, hogy én nem találtam meg, éppen ezért kértem segítséget (amit ismételten köszönök)
én a 26121-esben szereplő kérdésről írtam, hogy másképp nem tudom megcsinálni, mégpedig azért nem, mert egyszerre két mezőt (pontosabban azok viszonyát) kellene vizsgálnia, ezért nem hasonlítható össze a 26112-es és a 26121-es kérdése
viszont rögtön meggyőzöl, ha erre, a 26121-esben szereplő kérdésre is mutatsz egy megoldást, ami csak a táblázat saját mezőit használja: kik kaptak a havi fizetésüknél (D oszlop) több prémiumot (K oszlop)?
én nagyon megköszönném...
-
-
bara17
tag
kb ugyanezt csináltam, csak az A oszlop mellé darabteli függvénnyel megszámoltam, hogy az adott elem hányszor van benne a tartományban majd a max függvényel a max értéket kikerestem és index/hol.van-nal az értékhez tartozó elemet megkerestem
Csak azt hittem van más megoldás
Ja és köszönöm
-
hhheni
tag
válasz
Delila_1
#26112
üzenetére
köszönöm szépen, a megoldásod teljesen jó, csak annyit kellett rajta módosítanom, hogy a D : D-t D1 : D190-re javítottam, mert ami táblázatot kaptam, abban lejjebb másféle adatok vannak
a fiktív mező viszont adott esetben kell a kritériumtáblába, én legalább is nem tudom megkerülni
pl. van egy ilyen kérdés is: kik kaptak a havi fizetésüknél (D oszlop) több prémiumot (K oszlop)
ezt én csak úgy tudtam megoldani, hogy fölvettem egy "többet" nevű fiktív mezőt, alá d2<k2, és tökéletesen működik
vagy tudsz erre is jobbat?
köszi előre is! -
bara17
tag
Lehet nagyon láma kérdést teszek fel, de létezik ki olyan függvény ami kiírja egy cellába egy adott oszlop leggyakoribb szövegét. pl. A oszlopban vannak a győztesek nevei és ki nyerte a legtöbbet?
A problémát meg tudom oldani darabteli, max és match/index függvényekkel, de lehet én nem tudom az egyszerűbb megoldást...(bár ez sem annyira bonyoltult).
-
Louro
őstag
Akkor csalok - sajnos letölteni nem tudom a csatolmányt.
Szerk.: Nincs is ciklus az én kiegészítésemben. Én csak a ciklus után tettem be két sort. Nem kellene ettől bergadnia.
Range("G1:G65535") = "=HA(D1="""","""",D1-C1)" 'Angol excelben =IF(.....) Itt csak annyit vizsgálok, hogy D üres -e.
Range("H1:H65535") = "=HAHIBA(F1/G1,"""")" 'Angol excel esetén "=IFERROR(F1/G1,"""")" -
-
hhheni
tag
sziasztok!
megint a kritériumtáblával szívok
több más feltétel között szerepel az is, hogy a pasi fizetése (ami a D oszlopban található) az átlagosnál nagyobb legyen
én ezt csak úgy tudom megoldani, hogy beírok egy fiktív, "számolás" nevű mezőt a kritériumtáblába, és alá ezt a képletet: =D2>ÁTLAG($D$2:$D$190), és így működik is
nem tudja valaki ezt a feltételt közvetlenül a D (fizetés) oszlopra megfogalmazni, hogy ne kelljen új mezőt bevezetnem?
köszi minden ötletet!
heni -
Louro
őstag
EGy próbát megér, ha jól értem a feladatot.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lrow As Single
Dim AStr As String
Dim Value As Variant
If Not Intersect(Target, Range("A:B")) Is Nothing Then
For Each Value In Target
If Value <> "" Then
Range("C" & Value.Row).Value = Now
End If
Next Value
End If
If Not Intersect(Target, Range("E:F")) Is Nothing Then
For Each cl In Intersect(Target, Range("E:F")).Cells
Cells(cl.Row, "D").Value = Now()
Next
End If
Range("G1:G"&ActiveSheet.Usedrange.Rows.Count) = "=D1-C1"
Range("H1:H"&ActiveSheet.Usedrange.Rows.Count) = "=HAHIBA(F1/G1,"""")" 'Angol excel esetén "=IFERROR(F1/G1,"""")"
End Sub -
Locsi
senior tag
Még egy kérdésem lenne. Hogy lehetne ennél azt megcsinálni, hogy a két kitöltött oszlopból (D-C) kiszámolja a az eltelt időkülönbséget (2015.03.20 8:55:35 - 2015.03.20 8:54:33) azt beírja a G oszlopba, és ezt elossza az F oszlopban lévő értékkel, az meg beírja a H oszlopba. A segítséget köszönöm.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lrow As Single
Dim AStr As String
Dim Value As Variant
If Not Intersect(Target, Range("A:B")) Is Nothing Then
For Each Value In Target
If Value <> "" Then
Range("C" & Value.Row).Value = Now
End If
Next Value
End If
If Not Intersect(Target, Range("E:F")) Is Nothing Then
For Each cl In Intersect(Target, Range("E:F")).Cells
Cells(cl.Row, "D").Value = Now()
Next
End If
End Sub -
Delila_1
veterán
válasz
cellpeti
#26094
üzenetére
A lenti makró bekéri a keresendő szöveget, és az összes lapon kipirosítja ezeknek a hátterét.
Sub Piros()
Dim lap As Integer, ter As Range, keres As String
Dim CV As Object
keres = Application.InputBox(prompt:="Kérem a keresendő szöveget", Type:=2)
For lap = 1 To Worksheets.Count
Sheets(lap).Activate
Set ter = Range(Cells(1, 1), Cells(ActiveSheet.UsedRange.Rows.Count, _
ActiveSheet.UsedRange.Columns.Count))
For Each CV In ter
If CV = keres Then Range(CV.Address).Interior.ColorIndex = 3
Next
Next
End Sub -
Fferi50
Topikgazda
válasz
cellpeti
#26104
üzenetére
Szia!
Át kell menni a VBA ablakba. Alt+F11 billentyű.
Itt látod a VBA projektet (ha nem látod, akkor menüben view - Project explorer).
Abban van egy Thisworkbook nevű elem, ha rákattintasz kettőt, akkor megjelenik a kódlapja.
A bal oldali lenyílóból válaszd ki a Workbook -ot. Megjelenik egy
Private Sub Workbook_Open()
End Subkódkeret.
Ide kell bemásolnod amit írtam a korábbi hsz-ban.Üdv.
-
Louro
őstag
válasz
bara17
#26097
üzenetére
Akkor egy segédmunkalapon felírnám a munkalapokat egymás alá. X-et tetetnék, amibe kell másolni. Majd szűrő az X-re, a megmaradt neveket tömbbe gyűjteném majd ciklussal a megfelelő munkalapokra másolnám. Ne bonyolítsuk, hogy munkalaponként máshová
Szűréshez kulcssszó:autofilter
...Szanaszét kommentelten. Fáradtan ez lett.....valószínűleg a topiktulaj tud majd szebbet is.
Sub Munkalapozó()
Dim MunkalapTomb As Variant
Dim WS As String
Dim lastrow As Integer
'Segéd sheet-en a munkalapok nevei. x-szel kell jelölni, hogy mi kell
Sheets("Segéd").Range("A1:B200").AutoFilter Field:=2, Criteria1:="x"
Range("A2:A" & ActiveSheet.UsedRange.Rows.Count).SpecialCells(xlCellTypeVisible).Select
'mennyi munkalapról van szó. Mekkora lesz a tömb
lastrow = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Rows.Count
'másolás
Selection.Copy
'beillesztés egy segédoszlopba
Range("E1").PasteSpecial xlPasteValues
'tömbbe másolás
MunkalapTomb = Sheets("Segéd").Range("E1:E" & lastrow).Value
'segédoszlop törlése
Range("E1:E" & lastrow).Clear
'ciklus amekkora a tömb mérete
For i = 1 To UBound(MunkalapTomb)
'vegye ki a tömb soron következő elemét
WS = MunkalapTomb(i, 1)
'itt kell megadni, hogy mit akarsz másolni
Sheets("Segéd").Range("A1:A10").Select
'vágólapra tegye ki
Selection.Copy
'a megfelelő munkalapra illessze be az A1-től.
Sheets(WS).Range("A1").PasteSpecial xlPasteValues
Next
'Szűrő kikapcsolása
Sheets("Segéd").AutoFilterMode = False
End Sub -
Fferi50
Topikgazda
Szia!
" ha az f mezőbe beírok valamit, akkor a d mezőbe beírja az aktuális dátumot, és időt."
Remélem oszlopra gondoltál...
If Not Intersect(Target, Range("F:F")) Is Nothing Then
For Each cl In Intersect(Target, Range("F:F")).Cells
Cells(cl.Row, "D").Value = Now()
Next
End IfÜdv.
(Elkerülheted a "hangulatjeleket", ha használod az alul levő programkód gombot.)
Csak a kérdés, hogy a fentiből melyik kell.
.
Új hozzászólás Aktív témák
Hirdetés
- Microsoft licencek KIVÉTELES ÁRON AZONNAL - UTALÁSSAL IS AUTOMATIKUS KÉZBESÍTÉS - Windows és Office
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem, Most kedvező áron!
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Azonnali készpénzes GAMER / üzleti notebook felvásárlás személyesen / csomagküldéssel korrekt áron
- BESZÁMÍTÁS! ASUS ROG Ally Z1 Extreme 512GB SSD játékkonzol garanciával hibátlan működéssel
- BESZÁMÍTÁS! Gigabyte B760M i5 14600KF 32GB DDR4 1TB SSD RX 6700XT 12GB Zalman Z1 Plus Seasonic 650W
- ÁRGARANCIA!Épített KomPhone Ryzen 5 5600X 16/32/64GB RAM RX 7600 8GB GAMER PC termékbeszámítással
- ÁRCSÖKKENTÉS Dell Latitude E6320 notebook eladó
Állásajánlatok
Cég: Liszt Ferenc Zeneművészeti Egyetem
Város: Budapest
Cég: CAMERA-PRO Hungary Kft
Város: Budapest