- Milyen processzort vegyek?
- LG LCD és LED TV-k
- Milyen belső merevlemezt vegyek?
- Strand vagy hűvös szoba? A hardverek tudják a választ!
- VR topik (Oculus Rift, stb.)
- Milyen asztali (teljes vagy fél-) gépet vegyek?
- AMD Ryzen 9 / 7 / 5 7***(X) "Zen 4" (AM5)
- Projektor topic
- iPad topik
- A kánikula elviseléséhez hardverek is kellhetnek a napernyő mellé
Hirdetés
-
Megérkezett Magyarországra a Samsung új OLED gaming monitora
ph Az Odyssey OLED G8 32 hüvelyes, sík OLED panellel dolgozik.
-
Biztonsági aggályok miatt késik a Microsoft hatalmas AI-újítása
it A Microsoft úgy döntött, hogy biztonsági aggályok miatt elhalasztja a Recall AI funkciót, így azt csak szűkebb körben tesztelik egyelőre.
-
Spyra: nagynyomású, akkus, automata vízipuska
lo Type-C port, egy töltéssel 2200 lövés, több, mint 2 kg-os súly, automata víz felszívás... Start the epic! :)
-
PROHARDVER!
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
-
zsolti_20
senior tag
Sub Get_Data_From_File()
Dim FileToOpen As Variant
Dim OpenBook As Workbook
Application.ScreenUpdating = False
FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls")
If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
OpenBook.Sheets(1).Range("A1:A2").Copy
ThisWorkbook.Worksheets("asd").Range("A1").PasteSpecial xlPasteValues
OpenBook.Close False
End If
Application.ScreenUpdating = True
End
SubEzt a macrot találtam amivel egyik excel filebol a másikba át tudom másolni az adatokat. A problémám vele, hogy csak cellából cellába tudok. Megoldható egy kissebb átalakítással hogy az excel fileban lévő sheet neveket emelje át a cellába?
-
Delila_1
Topikgazda
válasz zsolti_20 #43102 üzenetére
Ügyelj rá, hogy az utvonal értékadása "\"-re végződjön.
Sub Lapnevek()
Dim FN As String, lap As Integer, WS As Worksheet, WB As Workbook
Dim utvonal As String
utvonal = "D:\Főmappa\Almappa\" 'megnyitandó fájl útvonala
FN = "Fájlnév.xlsx" 'megnyitandó fájl neve
Set WS = ActiveWorkbook.Sheets(1)
Workbooks.Open utvonal & FN
Set WB = ActiveWorkbook
WS.Activate
With Workbooks(WB.Name)
For lap = 1 To .Sheets.Count
Cells(lap, "A") = WB.Sheets(lap).Name
Next
End With
WB.Close False
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
zsolti_20
senior tag
-
Delila_1
Topikgazda
-
zsolti_20
senior tag
válasz Delila_1 #43106 üzenetére
Ígérem mára az utolsó kérdés Van két excel fileom, az elsőben az A oszlopban lefelé vannak számok felsorolva, amik mellett a B oszlopban adat van megadva Pl 1 | a 2 | b stb...
Itt van jó pár száz sor. A másik excel fileban van a több száz szám közül néhány, van amikor 5 de van amikor 20. Szeretném ezeket a számokat megkeresni az első excel fileban, és a megfelelő szám mellé a megfelelő értéket átmásolni, hogy ne nekem kelljen egyesével kikeresgélni.Sub VlookMultipleWorkbooks()
Dim lookFor As Range
Dim srchRange As Range
Dim book1 As Workbook
Dim book2 As Workbook
Dim book2Name As String
book2Name = "1.xlsx" 'modify it as per your requirement
Dim book2NamePath As String
book2NamePath = ThisWorkbook.Path & "\" & book2Name
Set book1 = ThisWorkbook
If IsOpen(book2Name) = False Then Workbooks.Open (book2NamePath)
Set book2 = Workbooks(book2Name)
Set lookFor = book1.Sheets(1).Cells(5, 1) ' value to find
Set srchRange = book2.Sheets(1).Range("A:B") 'source
lookFor.Offset(0, 1).Value = Application.VLookup(lookFor, srchRange, 2, False)
End Sub
Function IsOpen(strWkbNm As String) As Boolean
On Error Resume Next
Dim wBook As Workbook
Set wBook = Workbooks(strWkbNm)
If wBook Is Nothing Then 'Not open
IsOpen = False
Set wBook = Nothing
On Error GoTo 0
Else
IsOpen = True
Set wBook = Nothing
On Error GoTo 0
End If
End Function
Ez a kód egész jó lenne, de a probléma az, hogy abba a sorba akarja beilleszteni az értéket ahonnan kimásolta előtte, de az adott szám nem a 68-ik sorban van hanem mondjuk a harmadikban.
A másik probléma hogy csak egy értéket másol át de én az összeset szeretném egyszerre. -
Delila_1
Topikgazda
válasz zsolti_20 #43107 üzenetére
Képlettel is megoldhatod, makró nélkül. A képen balra van az első füzet, jobbra pedig az, ahova be akarod másolni az egyes számokhoz tartozó adatokat.
A második füzet B1 cellájának a képlete=INDEX([Munkafüzet1]Munka1!$A:$B;HOL.VAN(A1;[Munkafüzet1]Munka1!$A:$A;0);2)
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
zsolti_20
senior tag
válasz Delila_1 #43108 üzenetére
Már majdnem megvagyok a segítségeddel és pár órányi utána olvasással, csak 1 valamit kellene korrigálnom, a fájlneveket. A kódomban így szerepelnek:
Set w1 = Workbooks("1.xlsx").Sheets("Sheet1")
Set w2 = Workbooks("2.xlsx").Sheets("Sheet1")
A 2. fileban vannak számok amikhez az értékeket az 1. fileból kellene kiolvasnia, szóval csinál egy keresést az 1. fileban, és ha van egyezés akkor annak értékét ámtásolja a 2. fileba. Az első file neve az mindig fix azzal nincs is probléma, de a második az mindig változik, így állandóan át kellene írni a kódban.
Lehetséges a második file nevét úgy megkapni, hogy betallózom? Így kaphatnék egy dinamikus változót file névnek. -
Delila_1
Topikgazda
válasz zsolti_20 #43110 üzenetére
Set FD = Application.FileDialog(3)
With FD
.AllowMultiSelect = False 'letiltja a többszörös kijelölést
.Show 'Indítja a dialógboxot
If .SelectedItems.Count = 0 Then
MsgBox "Nem választottál fájlt, befejezzük.", vbInformation
Else
Fajnev= .SelectedItems(1)
'Fajnev megnyitása
w1.Activate 'ha kell, az első füzet aktívvá tétele
'műveletek
'megnyitott füzet bezárása
End If
End WithMásik módszer lehet, hogy a wb1-ben felsorolod egy oszlopban a fájlokat, és egy ciklusban nyitod meg és hajtod végre az utasításokat, zárod be a megnyitott füzetet. A megnyitandó fájl nevét a felsorolásból veszed.
sor=1
Do While Cells(sor,1)<>""
FN=Cells(sor,1)
Workbooks.Open utvonal & FN
'...
'...
sor=sor+1
Loop[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
zsolti_20
senior tag
válasz Delila_1 #43111 üzenetére
Bedobom ide a teljes kódot, így lesz a legjobb. Kicsi alakítottam rajta, de sajnos mindig errort kapok pont ott ahol el kellene kezdenie átmásolni.
Function getFile() As Workbook
Dim fn As Variant
fn = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select workbook")
If TypeName(fn) <> "Boolean" Then Set getFile = Workbooks.Open(fn)
End Function
Sub useGetFile()
Dim Dic As Object, key As Variant, oCell As Range, i&
Dim wb1 As Workbook, wb2 As Workbook
Dim wb1Sheet1 As Worksheet, wb2Sheet1 As Worksheet
Set wb2 = getFile
If Not wb2 Is Nothing Then
On Error Resume Next
Set wb2Sheet1 = wb2.Sheets("Sheet1")
On Error GoTo 0
If Not wb2Sheet1 Is Nothing Then
Set wb1 = Workbooks("1.xlsx")
Set wb1Sheet1 = wb1.Sheets("Sheet1")
i = wb1.Cells.SpecialCells(xlCellTypeLastCell).Row
For Each oCell In wb1.Range("A1:A" & i)
If Not Dic.exists(oCell.Value) Then
Dic.Add oCell.Value, oCell.Offset(, 3).Value
End If
Next
i = wb2.Cells.SpecialCells(xlCellTypeLastCell).Row
For Each oCell In wb2.Range("A2:A" & i)
For Each key In Dic
If oCell.Value = key Then
oCell.Offset(, 2).Value = Dic(key)
End If
Next
Next
Else
MsgBox "Sheet1 not found in " & wb2.Name, vbCritical
End If
'Maybe close wb2 here?
wb2.Close SaveChanges:=False
Else
Debug.Print "User cancelled"
End If
Set wb1 = Nothing
Set wb2 = Nothing
Set wb1Sheet1 = Nothing
Set wb2Sheet1 = Nothing
End Sub -
Delila_1
Topikgazda
válasz zsolti_20 #43112 üzenetére
Inkább tegyél fel egy képet, amin látszik hogy milyen oszlopok vannak az gyűjtő-, és a többi füzetben. A többiből melyik adatokat kell bemásolni a gyűjtőbe.
A valós elrendezést küldd, ne úgy, hogy a gyűjtőben "például" a B oszlop adataihoz kell párosítani a többi füzet D oszlopának az adatait. Az adatok lehetnek kitaláltak, de az elrendezés NEM.Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Fferi50
őstag
válasz zsolti_20 #43112 üzenetére
Szia!
Úgy látom, a Dic objectumod nem lett megkreálva, csak definiáltad. Gondolom a Dictionary objektumot szeretnéd használni.
Akkor kell egy ilyen sor, mielőtt hivatkoznál rá:Set Dic=CreateObject("Scripting.Dictionary")
Ezért hibás a másolás kezdeted így első ránézésre.
Üdv. -
zsolti_20
senior tag
válasz Fferi50 #43115 üzenetére
Sajnos így is ugyan az a hiba. Ezt a kódot szerettem volna úgy átalakítani, hogy a megnyitott file legyen a második, és ne kelljen minden alkalommal átírnom:
Sub UpdateW2()
Dim Dic As Object, key As Variant, oCell As Range, i&
Dim w1 As Worksheet, w2 As Worksheet
Set Dic = CreateObject("Scripting.Dictionary")
Set w1 = Workbooks("1.xlsx").Sheets("Sheet1")
Set w2 = Workbooks("2.xlsx").Sheets("Sheet1")
i = w1.Cells.SpecialCells(xlCellTypeLastCell).Row
For Each oCell In w1.Range("A1:A" & i)
If Not Dic.exists(oCell.Value) Then
Dic.Add oCell.Value, oCell.Offset(, 3).Value
End If
Next
i = w2.Cells.SpecialCells(xlCellTypeLastCell).Row
For Each oCell In w2.Range("A2:A" & i)
For Each key In Dic
If oCell.Value = key Then
oCell.Offset(, 2).Value = Dic(key)
End If
Next
Next
End Sub
[ Szerkesztve ]
-
zsolti_20
senior tag
-
Fferi50
őstag
válasz zsolti_20 #43118 üzenetére
Szia!
Delila pont azt a kódrészt mutatta meg neked, amivel kitallózhatod a kívánt fájlt.
Az egész kódrészlet aSet w2 = Workbooks("2.xlsx").Sheets("Sheet1")
helyébe kerül.
Ahol pedig azt írja, hogy fajnev megnyitása, oda kell betenni ezt a sort.Set w2=Workbooks.Open(fajlnev).Sheets("Sheet1")
Üdv. -
zsolti_20
senior tag
válasz Fferi50 #43119 üzenetére
Köszönöm a segítséget, megpróbáltam de így is hiba üzentet kapok ezzel a kóddal:
Sub UpdateW2()
Dim Dic As Object, key As Variant, oCell As Range, i&
Dim w1 As Worksheet, w2 As Worksheet
Set Dic = CreateObject("Scripting.Dictionary")
Set w1 = Workbooks("1.xlsx").Sheets("Sheet1")
Set FD = Application.FileDialog(3)
With FD
.AllowMultiSelect = False 'letiltja a többszörös kijelölést
.Show 'Indítja a dialógboxot
If .SelectedItems.Count = 0 Then
MsgBox "Nem választottál fájlt, befejezzük.", vbInformation
Else
Fajnev = .SelectedItems(1)
Set w2 = Workbooks.Open(fajlnev).Sheets("Sheet1")
w1.Activate 'ha kell, az első füzet aktívvá tétele
'műveletek
'megnyitott füzet bezárása
End If
End With
i = w1.Cells.SpecialCells(xlCellTypeLastCell).Row
For Each oCell In w1.Range("A1:A" & i)
If Not Dic.exists(oCell.Value) Then
Dic.Add oCell.Value, oCell.Offset(, 3).Value
End If
Next
i = w2.Cells.SpecialCells(xlCellTypeLastCell).Row
For Each oCell In w2.Range("A2:A" & i)
For Each key In Dic
If oCell.Value = key Then
oCell.Offset(, 2).Value = Dic(key)
End If
Next
Next
End Sub
-
Delila_1
Topikgazda
válasz zsolti_20 #43114 üzenetére
Az AA oszlopba sorold fel a fájlneveket, kiterjesztéssel.
A makró sorra megnyitja a fájlokat. Első esetben a B oszlopba írja be a képleteket, amik az első fájlból keresik ki az értékeket.
Ahhoz, hogy a következő fájlnál ne írja ezeket felül, a másodikban való kereséshez a képletek a C oszlopba kerülnek, és így tovább. Nézd meg a Case utasításoknál, hogy mi változik.
Az első sorában az oszlop helye (B: B), a másodikban a félkövér, aláhúzott karakterrel írt érték.
"=IFERROR(VLOOKUP(RC[-1],[" & FN & "]Munka1!C1: C2,2,0),"""")"
A Case 5-től majd beírod a többit.Sub Kigyujtes()
Dim WsGy As Worksheet, WsInnen As Worksheet, usorGy As Long, szamlalo As Integer
Dim FN As String, sor As Long, usorFajlnev As Long, utvonal As String
utvonal = "F:\Főmappa\Almappa\" 'ide jön a saját útvonalad, a végén \ legyen
Set WsGy = ActiveWorkbook.Sheets(1)
usorGy = WsGy.Range("A" & Rows.Count).End(xlUp).Row
usorFajlnev = WsGy.Range("AA" & Rows.Count).End(xlUp).Row
szamlalo = 1
For sor = 1 To usorFajlnev
FN = Cells(sor, "AA") 'itt vannak a fájlnevek kiterjesztéssel
Workbooks.Open utvonal & FN
szamlalo = szamlalo + 1
Set WsInnen = ActiveWorkbook.Sheets(1)
Select Case szamlalo
Case 2
WsGy.Range("B1:B" & usorGy).FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-1],[" & FN & "]Munka1!C1:C2,2,0),"""")"
Case 3
WsGy.Range("C1:C" & usorGy).FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-2],[" & FN & "]Munka1!C1:C2,2,0),"""")"
Case 4
WsGy.Range("D1:D" & usorGy).FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-3],[" & FN & "]Munka1!C1:C2,2,0),"""")"
Case 5
Case 6
Case 7
Case 8
Case 9
Case 10
Case 11
End Select
ActiveWorkbook.Close False
'ha a képletek helyett fix értékeket szeretnél, a lenti két sort aktiváld
' Range("B:K").Copy
' Range("B1").PasteSpecial xlPasteValues
Next
End Sub[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Mela Kehes
addikt
Üdv!
Alap excel ismeretem van csak, néhány függvényt használok. Szeretném jobban megismerni a programot. Tudtok ajánlani ehhez könyvet, vagy honlapot?
"Ha lehet menni akkor menjünk, ha meg tökölni kell akkor meg tököljünk."
-
qqzs
őstag
Legujabb excelben tegnap szivtam majdnem egy nagyot. Egy oszlopot akartam arrébb rakni. A google sheetben ez ugy mukodik, hogy arrébbrakom akkor beszúrja az uj helyre. Megfogtam az excelben az oszlopot majd arrebbhuztam a negyiranyu nyil kurzorral es szolt hogy az uj helyen mar van adat, felul akarom e irni. Mivel nem akartam ezert probaltam ugyanazzal a kurzorral, de ctlr nyomva. Ez sikerult is...ugy hogy felulirta az oszlopot...gyorsan nyomtam az undo-t...ami nem volt...ujraelesztes utan a megnyitott file eredetijet lemasolva sikerult kimentenem a felulirt oszlopot es forgott tovabb a fold, de azert megis ez most komoly 2020-ban itt tartunk?
Eladó: GTS450
-
sztanozs
veterán
Az hogy valamikor van, máskor meg nincs undo az by design. Én annak örülök, ha egy hosszabb lekérdezés alatt nem crashel be az excel (vagy nem kezdi újra)... Most pl 40 perc után 78%-nál fut egy lekérdezés, folyamatosan imádkozok, hogy újra ne kezdje.
[ Szerkesztve ]
JOGI NYILATKOZAT: A bejegyzéseim és hozzászólásaim a személyes véleményemet tükrözik; ezek nem tekinthetők a munkáltatóm hivatalos állásfoglalásának...
-
qqzs
őstag
Most latom, hogy egyaltalan nincs undo filter nezetben. akar ha egy cellat beirok, mikor irom undo nyil a ribbonon elo, de enter utan eltunik es nem tudok undozni
Eladó: GTS450
-
őstag
válasz Fferi50 #43095 üzenetére
Szia!
Közben rászántam az időt és megoldottam a problémát, maradtam a pivot kimutatásoknál.
Amugy Excelben van az adatbázis.
Azt hogy tudom megoldani, hogy az összes olyan lapot ami nincs rejtve és úgy kezdődik a neve, hogy “EE_” azt nyomtassa ki egy PDF fileba?Minden munkalap egy A4-es oldalt tartalmaz, aminek az előláb részében be van állítva az oldalszám. Ha kijelölöm őket kézzel, (tehát az összes amit ki akarok nyomtatni ki van választva egyszerre) és rámegyek a nyomtatára akkor az oldalszámok is növekvő sorrendben vannak egymás után.
Ez lenne a cél, csak gombnyomásra.Köszönöm
-
Fferi50
őstag
válasz Richard #43130 üzenetére
Szia!
Jó, hogy megoldottad a problémát.
A nyomtatáshoz 2 lehetőség is van szerintem. Az egyik, hogy beállítod a nyomtatási kimenetet PDF formátumra.
Ezt makróból is meg lehet csinálni, csak meg kell nézni, hogy a kézi beállítás után mit mond az Application.ActivePrinter tulajdonság. Arra kell makróban beállíítani utána.
Ezután kijelölöd a nyomtatásra a munkalapokat.Sub nyomtat()
Dim lap As Worksheet, nyomtatni As Variant, nyomtato As String
nyomtato = Application.ActivePrinter
Application.ActivePrinter = "Microsoft Print to PDF a(z) Ne03: kimeneten"
For Each lap In Worksheets
If Left(lap.Name, 3) = "EE_" And lap.Visible = xlSheetVisible Then nyomtatni = nyomtatni & "," & lap.Name
Next
nyomtatni = Mid(nyomtatni, 2)
nyomtatni = Split(nyomtatni, ",")
ActiveWorkbook.Sheets(nyomtatni).PrintOut , printtofile:=True, prtofilename:="C:\users\user\xx.pdf", Copies:=1, Collate _
:=True, IgnorePrintAreas:=False
Application.ActivePrinter = nyomtato
End Sub
A másik lehetőség, amikor nem jelölöd ki a PDF nyomtatót, hanem mentés másként nyomtatod ki PDF formátumban a kijelölt munkalapokat:Sub nyomtatb()
Dim lap As Worksheet, nyomtatni As Variant, nyomtato As String
For Each lap In Worksheets
If Left(lap.Name, 3) = "EE_" And lap.Visible = xlSheetVisible Then nyomtatni = nyomtatni & "," & lap.Name
Next
nyomtatni = Mid(nyomtatni, 2)
nyomtatni = Split(nyomtatni, ",")
Sheets(nyomtatni).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\Users\user\Documents\xx.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End Sub
A két változat úgy látom, szinte egyenrangú, de a másodiknál védett PDF fájl keletkezik és nagyobb is a mérete.Üdv.
-
ace05
senior tag
Szeretnék egy formot csinálni. Azt, hogy lehetne megcsinálni, hogy tegyük fel van 4 sorom, amiben az illető az előző munkahelyének adatait adja meg. De az illetőnek több munkahelye volt. Azt szeretném, hogy az illető adja meg, hogy hány előző munkahelye volt, majd utána az enter esetleg gomb leütéskor, másolja annyiszor azt a négy sort utána. Ezt, hogy lehetne megcsinálni ?
-
-
őstag
válasz Fferi50 #43131 üzenetére
Szia!
Köszönöm szépen! Így tényleg kinyomtat minden oldalt. Nekem valamiért a saját kódommal csak az elsőt nyomta ki
Egy kicsit módosítottam a kódod, hogy én adhassam meg hova és milyen néven mentsen.
Beteszem ide, hátha valakinek a későbbiekben szüksége lesz erre a verzióra.Sub nyomtatd()
Dim lap As Worksheet, nyomtatni As Variant, nyomtato As String
Dim mappavalaszto As Integer
Dim fajlnev As String
mappavalaszto = Application.FileDialog(msoFileDialogSaveAs).Show
If mappavalaszto <> 0 Then
fajlnev = Application.FileDialog(msoFileDialogSaveAs).SelectedItems(1)
For Each lap In Worksheets
If Left(lap.Name, 3) = "EE_" And lap.Visible = xlSheetVisible Then nyomtatni = nyomtatni & "," & lap.Name
Next
nyomtatni = Mid(nyomtatni, 2)
nyomtatni = Split(nyomtatni, ",")
Sheets(nyomtatni).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fajlnev, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End If
End Sub
-
szricsi_0917
tag
Sziasztok!
Egy kis segítséget szeretnék kérni, házszámot szeretnék szétválasztani a szám és a betű részére.Példák: 121a, 1-3b, 12/b/2, 1-3.
Idáig jutottam:
=MAX(HA(HIBÁS(SZÖVEG.KERES("1";H2));0;SZÖVEG.KERES("1";H2));....(benne vannak a számok 1-9.
Ezzel az a probléma, ha pl "212a" az érték akkor nem a 2. kettesnek a karakterszámát hozza fel. Lehet az egészet rossz oldalról közelítettem meg?!
Előre is köszönöm a segítséget! -
lappy
őstag
válasz szricsi_0917 #43136 üzenetére
mivel nincs benne szabályszerűség úgy elég nehéz rá függvényt alkotni
Bámulatos hol tart már a tudomány!
-
Mutt
aktív tag
Szia,
Nem tökéletes, de múkődnek az alábbi képletek ha a szövegben szám nem található betű után. Vagyis a példában mutatott 12/b/2-t nem szedi szét. Ennél különben mi lenne a helyes megoldás?
Ha A2-ben van a házszám, akkor B2-ben ez a képlet a szám részt adja vissza.
=BAL(A2;KERES(HOSSZ(A2)+1;SOR(INDIREKT("1:"&HOSSZ(A2)))/SZÁM(--KÖZÉP(A2;SOR(INDIREKT("1:"&HOSSZ(A2)));1))))
Ezek után a maradék szöveg képlete:
=HELYETTE(A2;B2;"")
Lehet egy kicsit tisztítani (megszabadulni az esetleges ponttól, perjeltől, szóköztől).
=KIMETSZ(HELYETTE(HELYETTE(HELYETTE(A2;B2;"");"/";"");".";""))
Másik megoldás pedig, hogy Excel 2010-tól van Power Query amiben van egy okos szövegdaraboló.
Ez sajnos el fogja rontani az "1-3b" példát, mert "1;-3;b" eredményt fog adni, de az M-code megfelelő módosításával a kötójel is felvehető a számok közé.
Előtte:Splitter.SplitTextByCharacterTransition({"0".."9"}, (c) => not List.Contains({"0".."9"}, c)), {"Házszám.1", "Házszám.2", "Házszám.3"}
Utánna:Splitter.SplitTextByCharacterTransition({"0".."9","-"}, (c) => not List.Contains({"0".."9","-"}, c)), {"Házszám.1", "Házszám.2"}
üdv
A tanácsaimat ingyen adom. Ha nem tetszik, akkor kérlek ne kritizáld! / https://github.com/viszi/codes/tree/master/Excel
-
Mutt
aktív tag
Elég sok VBA kód lett a fórumon mostanában megosztva, de közben már elérhetó a legújabb teszt verzióban egyeseknek az új makrózási nyelv, amelyet Office Scripts-nek hívnak és nagyon hasonlít a Google Scripts-hez vagyis egy JavaScript alapú programozási nyelv.
A https://docs.microsoft.com/en-us/office/dev/scripts/ oldalon lehet olvasni róla és a már létező függvényeket nézegetni.
Bill Jelen demózza is ebben a videójában.
Másik fontos változás, hogy aki Office 365-öt használ annak már az új tömbfüggvények is elérhetőek, vmint hogy már nem kell Ctrl+Shift+Enter-t használni tömbképletekhez. Ezekről itt lehet olvasni..
A tanácsaimat ingyen adom. Ha nem tetszik, akkor kérlek ne kritizáld! / https://github.com/viszi/codes/tree/master/Excel
-
Fferi50
őstag
válasz Richard #43135 üzenetére
Szia!
A Workbook BuiltinDocumentProperties tulajdonság Title és Author értékét megváltoztathatod makróval a közzététel előtt. Pl:ThisWorkbook.BuiltinDocumentProperties("Title")="Minta"
ThisWorkbook.BuiltinDocumentProperties("Author")="Senki"
Utána pedig visszaírod az eredetit.
Szerintem nézd meg még azIncludeDocProperties:=True helyett a False -ra
állítást, lehet, hogy ez is segít, ha csak elrejteni szeretnéd.Üdv.
-
Alex17
friss újonc
Sziasztok!
Ezekre az excel feladatokra kellene megoldas, es/vagy elmeleti utmutatas. Eleg surgos lenne. Koszonom Az Excel nem az erossegemxd -
Mutt
aktív tag
Szia,
Excel van írva, de ez egyértelműen adatbázis feladatsor, amelyhez az Officeban található Access (ha ingyenes kell akkor a LibreOfficeban található Base program a segítség). Access fórum itt található.
A másik probléma, hogy 4 táblát mond a leírás de csak 3 van megadva.
Excelben az alábbiakat tudod végrehajtani, de ahogy haladunk előre egyre inkább nem Excelről kellene beszélni.
1. Hozza létre a táblázatokat
Excelben mondjuk egy munkalap tartalmazza az összetartozó adatokat, a táblákat. A munkalap első sora legyen a fejléc a feladatban megadott nevekkel. Maradj a fejlécen és válaszd a Beszúrás -> Táblázat opcíót, hogy táblázattá tud alakítani a listádat (ezzel pár plusz lehetőséget kapsz).Accessben ez Létrehozás -> Tábla (vagy táblatervező)
2. Hozzon létre CSV fájlokat és töltse be a táblázatokba.
Hát ez elég tág feladat, de CSV fájl egy szöveges fájl amilt Jegyzettömbbel is létre lehet hozni, a lényeg hogy az adatok benne vesszővel (nálunk ez pontosvessző) vannak elválasztva.
pl. 1;1;T1800;5Az adatok feltöltése pedig a fájl importálást jelenti a Fájl -> Megnyitást használva, majd a beolvasott adatok másolásával az adott helyre.
Accessben ez Külső adatforrás -> Új adatforrás
3. Számolja ki a termék átlagárát és a középen elhelyezkedő termékek árát.
TERMÉKEK munkalapon kell a darabszámot és egységárat összesorozni (kezdőként a táblázat melletti F-oszlopba és az oszlop alján az ÁTLAG függvényt használni).A középen található termékekhez pedig a DOBOZOK és TERMÉKEK táblákat kell összekpacsolni (kulcsmező a termékkód) és a SZINT mezővel szűrve lehet megkapni a teljes árat (darabszám * egységár).
Accessben ezt lekérdezésnek hívják és aggregátor (összegző függvények kellenek).
Excelben a második részhez FKERES kell.4. Számolja az átlagárnál drágább termékek darabszámát.
Excelben DARABTELI függvény tud ebben segíteni.Access egy újabb lekérdezés.
5. Egységesítse a terméknevek formátumát.
TERMÉKEK táblán lehet a KISBETŰS/NAGYBETŰS/TNÉV függvények vmelyikét használni.Accessben a lekérdesében lehet LCase/UCase függvényeket ehhez haználni.
6. Listázza ki vevő alapján a rendelt termékek adatait.
Ez már nem alap Excel függvény, de korábban már volt itt ilyen kérdés. Vagy Kimutatás/Pivot vagy egy tömbfüggvényt javasoltunk, esetleg a vadúj SZŰRŐ függvényt.Access sima lekérdezés összekapcsolt táblákkal.
A többi feladathoz nincs elég adat, vagy nem Excelben kellene gondolkodni.
üdv
A tanácsaimat ingyen adom. Ha nem tetszik, akkor kérlek ne kritizáld! / https://github.com/viszi/codes/tree/master/Excel
-
kat0na
csendes tag
Sziasztok!
Van egy problémám amit meg szeretnék oldani.
Adott egy táblázat.
Range (H9:AF100)
Amit szeretnék, hogy ha egy cellában a betűszínt megváltoztatom, pl pirosra azt valahogy macrózhassam.Pl.: H9 cellába piros betűkkel írok be egy szöveget akkor teszem azt egy másik Workshiten a H9 cellában megjelenik egy "1"-es. Ha mindezt sima feketével írom akkor ne írjon semmit vagy "0". Ha ez a különbség megvan onnan már tudom csinálni tovább. De egyszerűen nem jövök rá, hogy tudok "értéket" kapcsolni a Színhez.
Remélem érthető.
Előre is köszi.
[ Szerkesztve ]
Biztos vagy benne? :)
-
dikoz
újonc
Sziasztok!
Munkaidő nyilvántartással kapcsolatban szeretnék segítséget kérni.
Adott a linkelt táblázat.
Randomszerűen szeretném a munkaidőt beiratni minden hónapban úgy, hogy az alábbi feltételek teljesülnek:- egyszerre 2 ember van egy nap,
- 216 óra/fő havonta, minusz szabadság (órában számolva) vagy betegállomány,
- áprilisig 8 fő, utána 7.Az már csak hab lenne a tortán ha meg lehetne előre határozni, hogy személyenként havonta hány nap szabin vagy betegben volt. Persze az is fontos, hogy egy-egy ember havonta ne ugyan azokon a napokon dolgozzon.
Függvények között próbáltam szétnézni, nem találtam megfelelőt.
Nem tudom, hogy programozással ez egyáltalán megoldható-e?Magyar Excel 2013 verzióm van.
-
Delila_1
Topikgazda
válasz kat0na #43145 üzenetére
Ahhoz a laphoz kell rendelned a makrót, amelyikre az 1-eseket akarod beíratni.
Ahányszor rálépsz a kérdéses lapra, "letapogatja" a Munka1 lap celláit, és beírja a feltétel szerint az 1-et, ahova kell. A feltételnél a Munka1 helyére írd be a lapot igazi nevét.Private Sub Worksheet_Activate()
Dim CV As Range
For Each CV In Range("H9:AF100")
If Sheets("Munka1").Range(CV.Address).Font.ColorIndex = 3 Then Range(CV.Address) = 1
Next
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Kasya
nagyúr
Sziasztok!
Lenne 1-2 ezer onedrive kepem, amit szeretnek lebego ablakban megjeleniteni soronkent Excelben. Erre talaltam az alabbi megoldast.
A gondom az, hogy nem vagyok jartas a VBA-ban. Megcsinalom a lepeseket, de nem latom a macroban beilleszthetonek, vagy a hyperlink hivatkozast nem fogadja el helyesnek az Excel. Nem tudom mi lenne jo dontes, hogy mukodjon.
Tudnatok esetleg segiteni benne valahogy? -
Roland861010
addikt
Sziasztok,
Munkámból kifolyólag szükségem lenne egy olyan scrpitre vagy beállításra hogy bizonyos sorokat automatikusan át színezze mondjuk egy nappal a lejárta előtt, hogy ne felejtsem el.
Pl Sárga színű a cella amiben az van írva, hogy március 6 ellenőrzés ... ez március 5-ikén át vált pirosra vagy lilára vagy bármire
Lehetséges ez ?
Előre is köszi!
Új hozzászólás Aktív témák
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! LEGOLCSÓBB! Automatikus 0-24
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- 10 Darab PC Játék (Bontatlanul!) Egyben 6990Ft.-ért Foxal!!!
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Canva Pro előfizetés - 1 éves