-
Fototrend
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
-
m.zmrzlina
senior tag
válasz csferke #29449 üzenetére
Automatikus megoldás:/munkalaphoz rendelve a makrót/
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End SubElőnye, hogy a begépelt szöveget <Enter>-re a kívánt formátumra állítja hátránya, hogy .xlsm-ként kell menteni a munkafüzetet.
Feltételes formázásos megoldás:
Itt a usert erőlteted hogy az általad kívánt formátumban vigye be az adatot.
Nem magamtól vagyok ilyen okos innen loptam.
[ Szerkesztve ]
-
csferke
senior tag
válasz m.zmrzlina #29451 üzenetére
Szia!
Kicsit "mélyebben" átnéztem a linket amit küldtél [link] és a következőt találtamPrivate Sub Worksheet_Change(ByVal Target As Range)
''''''''''''''''''''''''''''''''''''''''''''
' Forces text to UPPER case for the range
''''''''''''''''''''''''''''''''''''''''''''
If Target.Cells.Count > 1 Or Target.HasFormula Then Exit Sub
If Not Intersect(Target, Range("C14:J14")) Is Nothing Then
Application.EnableEvents = False
Target = UCase(Target)
Application.EnableEvents = True
End If
End SubEzzel nem kell vizsgálni a bevitt adatokat. A munkafüzetet pedig különben is xlsm-ként kell mentenem.
[ Szerkesztve ]
-
Belnir
csendes tag
Felmerült egy probléma. Azt vettem észre, hogy a változást csak akkor logolja, ha semmiről-valamire vagy valamiről-valamire változott az érték. Ha galád módon valaki valamiről-semmire változtat egy cellaértéket, arról nem jön létre a log-sor (magyarán szemétségből valaki töröl egy cellatartalmat, és bemószerolja a másikat).
A kód ilyen:Public aktualis
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastrow As Long
Dim akt_lap As String: akt_lap = ActiveSheet.Name
If Target.Count <> 1 Then Exit Sub
If aktualis = Target.Value Then Exit Sub
Application.ScreenUpdating = False
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Logfile = FSO.OpenTextFile("\eleresi_utvonal\log.txt", 8, True)
Logfile.WriteLine ("VÁLTOZTAT" & " - " & Format(Now, "YYYY.MM.DD hh:mm:ss") & " - " & Environ$("username") & " - " & Application.UserName & " - " & Environ$("computername") & " - " & Target.Parent.Name & " - " & Target.Address & " - " & aktualis & " - " & Target.Value)
Logfile.Close
Set Logfile = Nothing
Set FSO = Nothing
xit:
Worksheets(akt_lap).Activate
Selection.Activate
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
aktualis = ActiveCell.Value
End SubMit írjunk még bele, hogy azt is logolja?
Intel G4560, AsRock B150M-HDS, 8Gb RAM
-
PETEE78
senior tag
Sziasztok!
Hogy lehet megadni egy fájl nevét, ha csak az elejét ismerem?
Mondjuk addig, hogy: 221_ALMA_20151111........ .csv
A pontozott részen lévő karaktereket nem tudom, csak a kiterjesztést
A 151111 része napi dátum révén változik.mystring = Format(Now(), "yyyymmdd")
sdateform = Mid(mystring, 3)filename = "221_ALMA_20" & sdateform &".csv"
oldPath = "X:\BLABLA\221_A"
newPath = "C:\probakonyvtar\151111"
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile oldPath & "\" & filename, newPath & "\" & filename
Set fs = NothingYou are being revived
-
Fferi50
őstag
válasz PETEE78 #29457 üzenetére
Szia!
A csillag karakterrel keresésben operálhatsz.
Próbáld meg a dir() függvénnyel megnézni, hogy milyen fájlok vannak a keresett helyen:
filename= dir("221_ALMA_20" & sdateform & "*.csv")
Ide beírhatod hozzá az elérési utat is, ha szükséges.
Ha filename="" akkor nem talált olyan fájlt, ami megfelelt a keresési feltételeknek - vagy nem abban a könyvtárban kerestél, amiben a fájl van, vagy egyáltalán nincs ilyen fájl.Utána a filename értékét - ha szükséges, kiegészítve az elérési úttal - már használhatod a megnyitáshoz, mert ott már nem lesznek benne csillag karakterek, hanem konkrét fájlnevet fog tartalmazni.
Üdv.
-
-
PETEE78
senior tag
köszi mindenkinek akkor próbálgatom...
You are being revived
-
PETEE78
senior tag
A dir megoldotta a kérdést
Köszi mindenkinek!mystring = Format(Now(), "yyyymmdd")
sdateform = Mid(mystring, 3)filename = Dir("X:\Kimeno\221_ALMA_20" & sdateform & "*.*")
oldPath = "X:\Kimeno\"
newPath = "C:\probakonyvtar\" & sdateform
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile oldPath & "\" & filename, newPath & "\" & filename
Set fs = NothingYou are being revived
-
senior tag
Sziasztok!
Meg van adva 188 darab évszám, X-től Y-ig. A feladat az, hogy a megadott intervallumokon belül megszámoljuk, hány darab évszám felel meg a feltételeknek (minél egyszerűbb módszerrel). A lényeg az, hogy a Darabteli függvénnyel kell megoldani. Mutatnék egy képet róla, mire is gondolok:
Valaki tudna segíteni?
⭐ Revolut meghívó ajándék 7500 Ft bónusszal | Raiffeisen Bank meghívó változó ajánlói bónusszal ⭐ Kérd privát üzenetben tőlem!
-
senior tag
-
senior tag
válasz Delila_1 #29465 üzenetére
Gondolkodtam egy kicsit. Vegyük az 1951-1967 tartományt, ez esetben Darabteli függvénnyel szerintem így kellene megszámolni a tartományba tartozó éveket:
=DARABTELI(A1:A188;">=1951")-DARABTELI(A1:A188;">=1967")
[ Szerkesztve ]
⭐ Revolut meghívó ajándék 7500 Ft bónusszal | Raiffeisen Bank meghívó változó ajánlói bónusszal ⭐ Kérd privát üzenetben tőlem!
-
poffsoft
addikt
válasz Belnir #29454 üzenetére
az if aktualis=
vizsgàlat miért kell?
ha a ws_change eventben vagy, tuti, hogy szerkesztettek, logold.
plusz ha valaki több cellát módosít, töröl egyszerre, arról sincs logod.
esetleg az
if target.count
helyett az értéket csak az 1. cellában nézd:
target(1,1).value
?
a writeline végére még beszúrnék egy lezáró "-" -t, hogy látsszon az üres érték is (ami a törlés).[ Szerkesztve ]
[ Szerkesztve ]
-
Belnir
csendes tag
válasz poffsoft #29468 üzenetére
Az if aktualis vizsgálat nem kell, csak fogalmam sincs, hogy mire vonatkozik...
Gyakorlatilag próbálkozom, az általatok adott kódokat fabrikáltam össze, ez működött, de nem 100%-osan. Szóval fogalmam sincs, mi a fölös sor és mi hiányzik.
plusz ha valaki több cellát módosít, töröl egyszerre, arról sincs logod sajnos igen, ez így van.
if target.count
helyett az értéket csak az 1. cellában nézd:
target(1,1).value
?
a writeline végére még beszúrnék egy lezáró "-" -t, hogy látsszon az üres érték is (ami a törlés).
Megtennéd, hogy kipucolod a szemetet és pótlod ami szükséges? Csak még nagyobb katyvaszt csinálnékKöszi!
Intel G4560, AsRock B150M-HDS, 8Gb RAM
-
m.zmrzlina
senior tag
válasz Fferi50 #29440 üzenetére
Azt sikerült megállapítani, hogy a kb 50 tartományból aminek a
Set rng_Akioszt = ws_Kabelo.range(str_Akioszt & "1:" & str_Akioszt & int_usor)
sor a program futása során egy ciklus értéket ad két olyan esetben akad ki, ahol az rng_Akioszt(1,1) értéke egy 256 karakternél hosszabb karaktersorozat. Valamint bármikor reprodukálni tudom a hibát, ha bármely tartomány (1,1)-es cellájában előállítom a fenti feltételt. Gondolom itt a fv valamilyen korlátjába ütközik a feldolgozás.
Az lenne a feladat, hogy ezekben a tartományokban határozzuk meg a legkisebb és a legnagyobb értékeket amik aztán egy számlálós ciklus -tól -ig határai lesznek. Nem feltétlen ragaszkodom munkalapfüggvényes megoldáshoz, megelégszem a legegyszerűbbel is.
-
Roxy27
tag
Sziasztok,
kellene egy kis segítség a következő témában:
van egy termelőgépi program, ahonnan mindenféle statisztikai adatokat szeretnénk feldolgozni. A baj az, hogy ebből a részéből nem lehet exportálni. Viszont pdf creatorba tudjuk nyomtatni, onnan pedig egy excel-be konvertálni. Így viszont cseppet szétkapja a formátumot. Vissza kellene rendezni, de "gyorsan"
Az excel úgy néz ki, hogy laponként rendez:
Minden fülön 6 componet és a látható módon a hozzá tartozó adatok. Ez összesen laponként 48 sor.
Nekünk viszont egy lapra kellene szedetni, ebben a formában:
Tudna erre valaki gyors megoldást?(összesen jelenleg 36db fül van... (esetleg ezt a későbbiekben állítani kellene, vagy tudnia kellene, hogy hány lap van összesen mert ez változó...)
Előre is köszi!!!!
[ Szerkesztve ]
Hogy egyszerűbb legyen...Megbízhatóságom: http://phmegbizhatosag.atw.hu/phtabla.php?nev=roxy27
-
szatocs1981
aktív tag
válasz Roxy27 #29471 üzenetére
Ezt lefuttatod 36x ( a lapokat egyesével aktiváld):
Idömböl most ennyi futotta erre.Sub Makro1()
utolso = Sheets("Végeredmény").Cells(Rows.Count, "A").End(xlUp).Row
For szorzo = 1 To 3
For sor = 1 To 8
Sheets("Végeredmény").Cells(utolso + 1, sor) = ActiveSheet.Cells(sor, "C").Value
If sor <> 1 Then
Sheets("Végeredmény").Cells(utolso + 1, sor + 7) = ActiveSheet.Cells(sor, "F").Value
End If
Next sor
utolso = utolso + 1
Next szorzo
End Sub[ Szerkesztve ]
-
Roxy27
tag
válasz szatocs1981 #29472 üzenetére
Köszi,
beállítottam a Makrót... elindítom, látszik, hogy dolgozik, de nem kerül semmi a "Végeredmény" sheet-re.
Ja, és mit is jelent, hogy egyesével aktiváljam?
Sajnos nem igazán értek hozzá...
KösziHogy egyszerűbb legyen...Megbízhatóságom: http://phmegbizhatosag.atw.hu/phtabla.php?nev=roxy27
-
szatocs1981
aktív tag
válasz Roxy27 #29473 üzenetére
Közben átírtam, mert nem volt jó:
Sub Makro1()
utolso = Sheets("Végeredmény").Cells(Rows.Count, "A").End(xlUp).Row
For szorzo = 0 To 16 Step 8
For sor = 1 To 8
ujsor = sor + szorzo
Sheets("Végeredmény").Cells(utolso + 1, sor) = ActiveSheet.Cells(ujsor, "C").Value
ActiveSheet.Cells(ujsor, "C").Select
If sor <> 1 Then
Sheets("Végeredmény").Cells(utolso + 1, sor + 7) = ActiveSheet.Cells(ujsor, "F").Value
ActiveSheet.Cells(ujsor, "F").Select
End If
Next sor
utolso = utolso + 1
Next szorzo
End SubPage1- lapra "rámész" és futtatod a makrót!
-
Roxy27
tag
válasz szatocs1981 #29474 üzenetére
Na most már dolgozik, de még nem okés...
minden sheet-ről csak az első 3 componest gyűjti...
nagy kérés lenne, ha egyszerre összeszedné az összes lapról automatikusan?
(ja és az első lapról mondjuk betenné a felső sorba a megnevezéseket...)Ez a későbbiekben napi feladat lenne, és jó lenne, ha gombnyomásra működne... remélem nem vagyok pofátlan
Előre is nagyon köszi a segítséged!!!!Hogy egyszerűbb legyen...Megbízhatóságom: http://phmegbizhatosag.atw.hu/phtabla.php?nev=roxy27
-
Roxy27
tag
válasz szatocs1981 #29477 üzenetére
Ja már értem miért... ugye írtam, hogy összesen 48 sor van egy lapon (de én úgy csináltam printscreen-t, hogy 24 látszódik, hogy még olvasható legyen... nem fér egy oldalra és nem akartam kicsinyíteni)
Így igazad van, a 45db-ot kigyűjti... csak 90 kellene Pont mégegyszer ennyi azaz összesen 6 component és az adatai vannak 1 lapon.
Nem sürgős azért... ha este vagy holnap van időd/kedved, úgy is bőven jó. Csak tényleg úgy lenne értelme, hogy egy makró az összeset egybe összegyűjti automatikusan.
KösziHogy egyszerűbb legyen...Megbízhatóságom: http://phmegbizhatosag.atw.hu/phtabla.php?nev=roxy27
-
Roxy27
tag
válasz szatocs1981 #29477 üzenetére
Na arra közben rájöttem, hogy mit kell megváltoztatni, hogy végignézze a teljes lapot:
For szorzo = 0 To 40 Step 8
Már csak a fejléc hiányzik, meg hogy gombnyomásra az összes sheet kigyüjtődjön automatikusan.Hogy egyszerűbb legyen...Megbízhatóságom: http://phmegbizhatosag.atw.hu/phtabla.php?nev=roxy27
-
Roxy27
tag
válasz szatocs1981 #29480 üzenetére
Hogy egyszerűbb legyen...Megbízhatóságom: http://phmegbizhatosag.atw.hu/phtabla.php?nev=roxy27
-
szatocs1981
aktív tag
válasz Roxy27 #29481 üzenetére
Fejléc és hibakezelés még nincs benne, próbáld ki:
Töröld a "Végeredmény" nevü fület, mielött futtatod a makrót!A makró létrehoz az elsö helyen egy "Végeredmény" nevü lapot, majd oda bemásolja az összes többi létezö lapról az adatokat, a megadot szabály szerint!
Sub Makro1()
Worksheets(1).Select
Sheets.Add
Worksheets(1).Name = "Végeredmény"
WS_Count = ActiveWorkbook.Worksheets.Count
For i = 2 To WS_Count
utolso = Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row
For szorzo = 0 To 40 Step 8
For sor = 1 To 8
ujsor = sor + szorzo
Worksheets(1).Cells(utolso + 1, sor) = Worksheets(i).Cells(ujsor, "C").Value
If sor <> 1 Then
Worksheets(1).Cells(utolso + 1, sor + 7) = Worksheets(i).Cells(ujsor, "F").Value
End If
Next sor
utolso = utolso + 1
Next szorzo
Next i
End Sub -
poffsoft
addikt
válasz Belnir #29469 üzenetére
Option Explicit
Public aktualis
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastrow As Long
Dim akt_lap As String: akt_lap = ActiveSheet.Name
Dim fso As Object
Dim logfile As Object
' If Target.Count <> 1 Then Exit Sub
' If aktualis = Target.Value Then Exit Sub
Application.ScreenUpdating = False
Set fso = CreateObject("Scripting.FileSystemObject")
Set logfile = fso.OpenTextFile("\eleresi_ut\log.txt", 8, True)
logfile.WriteLine ("VÁLTOZTAT" & " - " & Format(Now, "YYYY.MM.DD hh:mm:ss") & " - " & Environ$("username") & " - " & Application.UserName & " - " & Environ$("computername") & " - " & Target.Parent.Name & " - " & Target.Address & " - " & aktualis & " - " & Target(1, 1).Value & " -+")
logfile.Close
Set logfile = Nothing
Set fso = Nothing
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
aktualis = ActiveCell.Value
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
aktualis = ActiveCell.Value
End Sub[ Szerkesztve ]
[ Szerkesztve ]
-
Fferi50
őstag
válasz m.zmrzlina #29470 üzenetére
Szia!
Mi lenne, ha a keresésnél kihagynád az első oszlop celláit. (Ez megoldható vba-ban offset metódus használatával, vagy a tartományt e nélkül definiálod - a tartomány előtt levő cellára is lehet hivatkozni (!) így pl. tartomány(xsor,0) a tartomány x-edik sorában a tartomány előtt levő cellát adja meg.)
Üdv.
-
twingos
tag
Sziasztok,
Segítséget szeretnék ismét.
Mellékelek egy képet is mellé.
A oszlóban lévő adatok első 3 karakterét figyelve, írja B oszlopba az általam definiált értéket értéket. (Ahol találat van abc-re A oszlopban ott írja B oszlopba,hogy alma)
Próbáltam érthetően fogalmazni.
Megoldható ez függvénnyel?Köszönöm a segítséget
üdv
www.pc2car.hu - Számítógép az autóba
-
szatocs1981
aktív tag
válasz szatocs1981 #29482 üzenetére
Fejléccel:
Sub Makro1()
Worksheets(1).Select
Sheets.Add
Worksheets(1).Name = "Végeredmény"
WS_Count = ActiveWorkbook.Worksheets.Count
Call TiliToli("A", "E", 2, 0)
Call TiliToli("C", "F", WS_Count, 40)
End Sub
Sub TiliToli(Spalte1, Spalte2, ettol, eddig)
For i = 2 To ettol
utolso = Worksheets(1).Cells(Rows.Count, "A").End(xlUp).Row
For szorzo = 0 To eddig Step 8
For sor = 1 To 8
ujsor = sor + szorzo
Worksheets(1).Cells(utolso + 1, sor) = Worksheets(i).Cells(ujsor, Spalte1).Value
If sor <> 1 Then
Worksheets(1).Cells(utolso + 1, sor + 7) = Worksheets(i).Cells(ujsor, Spalte2).Value
End If
Next sor
utolso = utolso + 1
Next szorzo
Next i
End Sub -
m.zmrzlina
senior tag
válasz Fferi50 #29484 üzenetére
vagy a tartományt e nélkül definiálod
Ez ezt a hibát generálná amit /számomra/ bonyolultabb lenne eliminálni mint megkerülni a problémát.Helyette....
Mi lenne, ha a keresésnél kihagynád az első oszlop celláit Illetve minden oszlop első celláját.
Ez lett a megoldás.
Köszi. -
twingos
tag
válasz Delila_1 #29487 üzenetére
Szia,
Köszönöm a választ.
Szerintem sikerült ismét nem jól fogalmaznom.
Tehát az A oszlop a fix. Ha ott megtalálja az ABC kezdetű szót akkor B oszlopba írja ,hogy ALMA.
Tehát a B oszlop üres, és oda kellene beírnia , hogy ALMA.Bízok benne ,hogy így érthetőbb.
Ismét nagyon köszönöm a fáradozásodat!üdv
www.pc2car.hu - Számítógép az autóba
-
Belnir
csendes tag
válasz poffsoft #29483 üzenetére
Királyság, nagyon jó! Annyi észrevételem lenne, hogy egyből meg is akadt a kicsike. Alul duplázva maradt meg a
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
aktualis = ActiveCell.Value
End SubDe a kódot köszönöm, nagyon nagy segítséget kaptam!
[ Szerkesztve ]
Intel G4560, AsRock B150M-HDS, 8Gb RAM
-
sedyke
tag
Sziasztok!
Van egy alabbi makrom, amihez meg anno itt kaptam segitseget.
Lenyegeben a kulonbozo munkalapokon levo koltsegszamitasaimbol kereski ki a termekkodokat es sorakoztatja fel egy oszlopban a munkaful nevevel, hogy kesobb egy osszesito tablaban csak a termekkodok kelljen beirnom es fuggvenyekkel kikeresi az adatokat.
Amikor ezt a makrot valaki megirta nekem, akkor mukodott is. Ma ujrafuttattam, hogy az uj termekek is bekeruljenek a listaba, amiket az elmult honapokban csinaltam, viszont nem adja oket hozza a listahoz.
Vajon mi lehet az oka? Elore is koszi a segitseget.Sub termeklistas()
Dim sh As Worksheet, ws As Worksheet, xx As Integer, yy As Integer
Set ws = Sheets("Sheet1")
yy = 1
For Each sh In Worksheets
xx = 1
If sh.Name <> ws.Name Then
Do While True
If sh.Cells(xx, "B").Value = "" Then Exit Do
ws.Cells(yy, "N").Value = sh.Cells(xx, "B").Value
ws.Cells(yy, "O").Value = sh.Name & "!"
ws.Cells(yy, "P").Value = xx - 1
xx = xx + 51
yy = yy + 1
Loop
End If
Next
End Sub -
bara17
tag
Sziasztok!
Kimutatásban, hogyan tudom beállítani azt, hogy a hónapok nevei ne ábc sorrendben jelenjenek meg?
Köszönöm előre is.
[ Szerkesztve ]
-
sebi91
újonc
2007-et használok
Olyan problémám lenne hogy az excelbe importált adatoknál az egyik oszlopban a költségeket amik nagyobbak mint 999 azokat ilyen formátumban rakja be a cella bal oldalához igazítva 1 000,00 ( gondolom szövegként kezeli). A problémám az hogy a CSERE függvénnyel mindig csak egy intervallumon belül tudok cserélni. A 10 000,00 nél vagy a nagyobb értékeknél már nem tudok az általam létrehozott képlettel cserélni. =HA(Y2>-1;Y2;CSERE(J2;2;1;""))Ebben a képletben a Y2 oszlop adatait HAHIBA fügvénnyel adtam meg úgy hogy ha hibát talál a kerekítés adataiban ami az X oszlopban vannak akkor -5 öt írjon be helyette. Így a szóközös értékeknél -5-ötír ki. Így az egyik intervallumon ki tudom cseréltetni a CSERE függvénnyel. A kérdésem hogy minden intervallumon ami a milliónál vagy a százezreknél jelentkezik azt hogyan tudnám megoldani vagy van-e egyszerűbb megoldás is erre?
(próbáltam *1,számformátummá alakítani,)Előre is köszönöm a segítséget.
-
lenkei83
tag
Sziasztok!
Van esetleg valakinek valami infója arról, hogy az XLSB file formátumnak van e valami hátránya XLSX vagy XLSM-hez képest?
Köszi
P. -
MODERÁTOR
Van egy ilyen nem túl elegáns képletem:
=HA(HIBÁS(FKERES(D20;adattabla!$L$2:$M$10;2))=1;0;FKERES(D20;adattabla!$L$2:$M$10;2))
itt a D20 cellában egy legördülő listában kell kiválasztani az értéket. Alapból nem szerepel semmi a cellában.
kamulibre office-ban simán 0 volt a kapott érték, azonban ms office #hiányzik-ot dob, mert "hiba, nincs elérhető érték". hogyan lehet ezt megoldani?[ Szerkesztve ]
Nem vagyok hős, egész nap internetezek.