-
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
-
Fferi50
őstag
válasz RAiN91 #37649 üzenetére
Szia!
Rendszer beépített lehetőséget nem tudok rá. Viszont minden makró elejére beírhatod, hogy egy cellába beírjon egy szöveget, csak a makró végén ne felejtsd el kitörölni.
Vagy az állapotsort is felhasználhatod a futás jelzésére:Application.Statusbar=Szöveg ' hosszabb programok, ciklusok esetén itt szoktam kijelezni, hol tartunk éppen
Futás közben bármikor átírhatod különböző szövegekkel.
A futás végén pedig:Application.Statusbar=False ' ez visszadja a vezérlést a VBA-nak
Üdv.
[ Szerkesztve ]
-
twingos
tag
Sziasztok,
Segítséget szeretnék kérni.
Van egy táblázatom, ami 25 sheet-et tartalmaz. Nekem csak a 1-től 20. oldalig fontosak , a többin más adatok vannak és nem szeretném menteni pdf-be.
Macróval hogyan tudom megoldani, hogy jelölje ki azokat az oldalakat (1es és 20as sheet között) ahol az I3-as cella értéke nem üres és nullánál nagyobb. Ezeket mentse pdf-be.
A pdf mentést meg tudtam oldani, de csak úgy, hogy minden oldalt kijelöl (1-től 20ig) és úgy menti. Viszont előbbi esztétikusabb lenne, nem lennének üres oldalak.A hozzáértőknek biztos, hogy pár perc, én viszont elakadtam.
Köszönöm az építő jellegű segítséget.
üdv
twingos[ Szerkesztve ]
www.pc2car.hu - Számítógép az autóba
-
p5quser
tag
válasz Fferi50 #37652 üzenetére
Üdv!
Nem teljesen világos, hová kéne beszúrnom a copy parancsot. Ahová raktam, ott range copy metódus hibával elszállt.
Most így néz ki a script jelenleg, de így "előjeltelen"Private Sub CommandButton1_Click()
Dim xFso As Object
Dim xFld As Object
Dim xStrSearch As String
Dim xStrPath As String
Dim xStrFile As String
Dim xOut As Worksheet
Dim xWb As Workbook
Dim xWk As Worksheet
Dim xRow As Long
Dim xFound As Range
Dim xStrAddress As String
Dim xFileDialog As FileDialog
Dim xUpdate As Boolean
Dim xCount As Long
On Error GoTo ErrHandler
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Select a forlder"
If xFileDialog.Show = -1 Then
xStrPath = xFileDialog.SelectedItems(1)
End If
If xStrPath = "" Then Exit Sub
xStrSearch = "elszámol"
xUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
Set xOut = Worksheets.Add
xRow = 1
With xOut
.Cells(xRow, 1) = "Munkafüzet"
.Cells(xRow, 2) = "Munkalap"
.Cells(xRow, 3) = "Cella"
.Cells(xRow, 4) = "Találat"
.Cells(xRow, 5) = "Név"
.Cells(xRow, 6) = "Összeg"
Set xFso = CreateObject("Scripting.FileSystemObject")
Set xFld = xFso.GetFolder(xStrPath)
xStrFile = Dir(xStrPath & "\*.xls*")
Do While xStrFile <> ""
Set xWb = Workbooks.Open(Filename:=xStrPath & "\" & xStrFile, UpdateLinks:=0, ReadOnly:=True, AddToMRU:=False)
For Each xWk In xWb.Worksheets
Set xFound = xWk.UsedRange.Find(xStrSearch)
Set xFn = xWk.UsedRange.Find(xStrSearch)
If Not xFound Is Nothing Then
xStrAddress = xFound.Address
xNev = xFound.Offset(0, -1).Value
xOssz = xFound.Offset(0, 1).Value
End If
Do
If xFound Is Nothing Then
Exit Do
Else
xCount = xCount + 1
xRow = xRow + 1
.Cells(xRow, 1) = xWb.Name
.Cells(xRow, 2) = xWk.Name
.Cells(xRow, 3) = xFound.Address
.Cells(xRow, 4) = xFound.Value
.Cells(xRow, 5) = xNev
.Cells(xRow, 6) = xOssz
End If
Set xFound = xWk.Cells.FindNext(After:=xFound)
Loop While xStrAddress <> xFound.Address
Next
xWb.Close (False)
xStrFile = Dir
Loop
.Columns("A:F").EntireColumn.AutoFit
End With
MsgBox xCount & " egyezést találtam", , "Elszámolósdi"
ExitHandler:
Set xOut = Nothing
Set xWk = Nothing
Set xWb = Nothing
Set xFld = Nothing
Set xFso = Nothing
Application.ScreenUpdating = xUpdate
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler
End SubKöszönöm!
-
Pakliman
tag
válasz twingos #37653 üzenetére
Szia!
Egy lehetséges megoldás...
Public Sub qa()
Dim wsA As Worksheet: Set wsA = ActiveSheet
Dim wsArr
Dim wsDb As Integer
Dim ws As Worksheet
ReDim wsArr(0 To 0)
'Van egy táblázatom, ami 25 sheet-et tartalmaz. Nekem csak a 1-től 20. oldalig fontosak...
For Each ws In Worksheets
If Mid(ws.Name, 6) >= 1 And Mid(ws.Name, 6) <= 20 Then 'itt kell azonosítani a munkalapot, hogy kell-e egyáltalán
'ha az I3-as cella értéke nem üres...
If Not IsEmpty(ws.Range("I3")) Then
'... és nullánál nagyobb...
If ws.Range("I3") > 0 Then
wsDb = wsDb + 1
ReDim Preserve wsArr(1 To wsDb)
wsArr(wsDb) = ws.Name
End If
End If
End If
Next ws
If wsDb > 0 Then
Sheets(wsArr).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="d:\Ez az új.pdf"
End If
wsA.Select
End Sub[ Szerkesztve ]
-
Pakliman
tag
válasz Fferi50 #37657 üzenetére
Ez igaz.
Viszont mivel az "I3 cella értéke nullánál nagyobb" meghatározás számot feltételez, ezért valójában inkább még egy ellenőrzést kellene beépíteni:If IsNumeric(Ws.Range("I3")) then
.
Mivel lehet ott egy éppen hibát jelző függvény is.
Sajnos az "egyszerűsítés" nálam nem mindig működik, sokszor futok (időnként rejtett) hibára -
Pakliman
tag
válasz twingos #37659 üzenetére
Szia!
Én létrehoztam egy új munkafüzetet.
Abban létrehoztam 25 munkalapot (a neveik sorban: Munka1, Munka2, stb. Munka25)
AzIf Mid(ws.Name, 6) >= 1 And Mid(ws.Name, 6) <= 20 Then
sor ezeknek a neveknek megfelelően ellenőriz. Ha nálad nem ezek a nevek vannak (gyanítom ), akkor más szisztéma szerint kell megtalálnod, hogy az a munkalap kell-e neked (Pl.: egySelect Case
válogatás).
Szerintem itt lesz a gond egyébként
Ha leírod a figyelendő munkalapok neveit, akkor tudok többet segíteni.A munkalapok kijelölését azért nem láthatod, mert egyrészt "gyors" a program, másrészt pedig a progi végén visszaállítom az eredetileg aktív (
Set wsA = ActiveSheet
) munkalapot (wsA.Select
).[ Szerkesztve ]
-
mutyi
őstag
Van két csv file, az egyiket a disztribútor adja, a másikat a a magento rendszerből exportálom ki.
Miért van az, hogy a magentobol kiexportált csv file a google sheets-ben jelenik meg olvashatóan, az oszlokpok a helyükön vannak, de ugyanez a file a ms excel 2016-ban átláthatatlan.
És ugyanez fordítva. A disztribútortól kapott file meg ellenkezőleg, azaz a google sheets-ben rendezett és olvasható, átlátható, viszont az ms excel 2016-ban össze vissza van.A másik kérdésem az lenne, hogy ha valaki importál már magento rendszerbe, akkor hogyan kell kivitelezni azt, hogy ha különbözőek az attribútum nevek, akkor a disztribútor által használt nevek jó oszlopokba kerüljenek a magentobol ki exportált attribútumok oszlopaiba?
-
p5quser
tag
válasz Fferi50 #37664 üzenetére
Sub SearchFolders()
'UpdatebyKutoolsforExcel20151202
Dim xFso As Object
Dim xFld As Object
Dim xStrSearch As String
Dim xStrPath As String
Dim xStrFile As String
Dim xOut As Worksheet
Dim xWb As Workbook
Dim xWk As Worksheet
Dim xRow As Long
Dim xFound As Range
Dim xStrAddress As String
Dim xFileDialog As FileDialog
Dim xUpdate As Boolean
Dim xCount As Long
On Error GoTo ErrHandler
Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
xFileDialog.AllowMultiSelect = False
xFileDialog.Title = "Select a forlder"
If xFileDialog.Show = -1 Then
xStrPath = xFileDialog.SelectedItems(1)
End If
If xStrPath = "" Then Exit Sub
xStrSearch = "KTE"
xUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
Set xOut = Worksheets.Add
xRow = 1
With xOut
.Cells(xRow, 1) = "Workbook"
.Cells(xRow, 2) = "Worksheet"
.Cells(xRow, 3) = "Cell"
.Cells(xRow, 4) = "Text in Cell"
Set xFso = CreateObject("Scripting.FileSystemObject")
Set xFld = xFso.GetFolder(xStrPath)
xStrFile = Dir(xStrPath & "\*.xls*")
Do While xStrFile <> ""
Set xWb = Workbooks.Open(Filename:=xStrPath & "\" & xStrFile, UpdateLinks:=0, ReadOnly:=True, AddToMRU:=False)
For Each xWk In xWb.Worksheets
Set xFound = xWk.UsedRange.Find(xStrSearch)
If Not xFound Is Nothing Then
xStrAddress = xFound.Address
End If
Do
If xFound Is Nothing Then
Exit Do
Else
xCount = xCount + 1
xRow = xRow + 1
.Cells(xRow, 1) = xWb.Name
.Cells(xRow, 2) = xWk.Name
.Cells(xRow, 3) = xFound.Address
.Cells(xRow, 4) = xFound.Value
End If
Set xFound = xWk.Cells.FindNext(After:=xFound)
Loop While xStrAddress <> xFound.Address
Next
xWb.Close (False)
xStrFile = Dir
Loop
.Columns("A:D").EntireColumn.AutoFit
End With
MsgBox xCount & "cells have been found", , "Kutools for Excel"
ExitHandler:
Set xOut = Nothing
Set xWk = Nothing
Set xWb = Nothing
Set xFld = Nothing
Set xFso = Nothing
Application.ScreenUpdating = xUpdate
Exit Sub
ErrHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler
End SubEbből a szösszenetből lett plasztikázva.
Köszönöm a segítséget! -
mutyi
őstag
válasz Fferi50 #37663 üzenetére
Kimásoltam mind a két csv file első sorát és létrehoztam 1-1 új dokumentumot, majd csv-be mentettem.
A helyzet ugyanaz, tehát épp ellenkezőleg jó a két doksi,hogy google sheet-et használok vagy ms excel 2016-ot.https://drive.google.com/open?id=1FlFzJYzWje9zobVg0XLCA4JMGYXPwzydTfQy_SIOWIo
https://drive.google.com/open?id=1Y47qJ_6ZOWxRviPMHGJeajxaTg-61l10LWach2DakgU[ Szerkesztve ]
-
Fferi50
őstag
Szia!
Jobb lett volna látni az eredeti csv fájlban szereplő sort.
Most úgy gondolom, hogy a delimiter az egyikben biztosan pontosvessző (amit munkafüzet1 néven tettél fel), az Workbooks.OpenText metódussal kell megnyitnod, a semicolon paraméter=True értékkel.
A másiknál nem tudom, mi a határoló, de próbálgasd azt is az előző metódussal és a határoló paramétereinek változtatásával.Üdv.
-
Fferi50
őstag
Szia!
A beállítások, menüszalag testreszabása - minden parancs - szövegfájlból parancsot másold át a menüszalagra - új lap - új csoport ide tudod betenni.
Utána az új lapon megtalálod.Ha ezzel nem menne, akkor makró.
Sub megnyito()
Workbooks.OpenText "Fájlnév", DataType:=xlDelimited, semicolon:=True
End SubAlt+F11
Insert - Module
utána a fenti bemásolása.Üdv.
-
Fferi50
őstag
válasz p5quser #37673 üzenetére
Szia!
'Mint írtam, van működő kód, csak nem értem ezt az előjel váltást, és érdekelt, hogy mi nyűgje lehet.'
Ezek szerint amit leírtál kód, az mégsem működik megfelelően. Sajnos így látatlanban nem tudom megmondani, mi lehet a probléma. A kódnak elvileg jól kellene működnie.
Talán elküldhetnéd privátban.
Üdv.
-
modflow
veterán
A segítségeteket szeretném kérni. Egy nagy mátrixot kellene készítenem, de a cellák így totál olvashatatlanok lennének. Hogy lehetne azt megoldani, hogy a cellák tartalmát akkor mutassa tejles mértékben, ha felé viszem az egeret, vagy ha rákattintok??
-
bexinho23
őstag
Üdv!
Elég nagy problémám akadt az excellel. Van egy általam készített, elég jól összerakott költségvetési táblázat, amit édesanyámnak is (leegyszerűsítve) átadtam a laptopjára még 2017 januárjában. Azóta minden egyes nap becsületesen vezeti a be-, illetve kiadásait. Viszont tegnap, amikor az asztalán lévő parancsikonból megnyitotta volna a fájlt, azt vette észre, hogy a bevétel és kiadás oldalon csak 2017 november vége van, nem pedig a friss dátumos rögzítések. Google-ben, youtube-on, külföldi fórumokon már nézelődtem, de kifogott rajtam az eredeti állapot visszaállítása, ezért kérnem a segítségeteket.
Amit tudni kell:
Asztalon van egy parancsikon, aminek az eredeti fájlja a merevlemezen található a Google Drive mappában. A Google Drive online webfelületéről le tudtam tölteni egy "~$havi költségvetés - Anya.xlsx" nevezetű, 165 byte méretű fájlt, ami ha jól sejtem a drive-nak egy backup-olása, mivel a (drive online) kukában minden egyes napra visszamenőleg van egy ugyanilyen fájl.
Ezt a fájlt letöltöttem, és bemásoltam a merevlemezen a következő helyre:
"c:\Users\Anya\AppData\Roaming\Microsoft\Excel\"Az eredeti fájlt pedig:
"c:\Users\Anya\Documents\"Az Excel 2007-ben a biztonsági mentésnél ezek a mappák vannak megadva.
Amit próbáltam: fájl elindít, folyamatkezelőből kilövöm. Megnyitom újra, ekkor felajánl egy korábbi mentést, de nem az feladatkezelőből kilövés pillanatában keletkezett állapotot hozza vissza, nem pedig amit szeretnék.
Remélem érthetően írtam le, és sikerül megoldást találni. Mert nagyon rossz lenne, ha az elmúlt hónapok kútba esnének.
u.i.: Fogalmam sincs, hogy alakulhatott így, hiszen én 2014 óta vezetek ugyanígy egy táblázatot, amit a dropbox-szal szinkronizáltatok, és sosem volt ilyen problémám. Ráadásul én telefonon keresztül a dropboxos megnyitásból is módosítom a fájlt, illetve a laptopomról is a dropbox mappában...
-
tzimash
őstag
Hali,
a gombokat így generáltam:
Dim btn As Button
Dim t As Range
usor = Range("A" & Rows.Count).End(xlUp).Row
For sor = 2 To usor Step 1
Set t = ActiveSheet.Range(Cells(sor, 10), Cells(sor, 10))
Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
With btn
.Name = "btn" & sor
.Caption = "Könyvel"
.OnAction = "button_check"
End With
Next sorAzt szeretném, ha a gombra kattintva az adott sorból egy-egy változóba írná a mondjuk a B, C, E, F és I, cellák értékét.
Pl, ha az 5. sorban lévő gombra (btn5) kattintok, akkor a B5, C5, E5, F5, I5 cellák értékét szeretném megkapni.
Ez megoldható?
Hogyan nézne ki az a button_check sub?ill. még az is tervben van, hogy ha egy gomb fölé viszem az egeret, akkor az adott sorban lévő cellák hátterének színe A-I-ig megváltozzon. Ilyet lehet VBA-ban?
[ Szerkesztve ]
-
Delila_1
Topikgazda
válasz tzimash #37680 üzenetére
Nem kellenek gombok, elég egy, a laphoz rendelt makró.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim oszlop As Long, sor As Long, B, C, E, F, I
sor = Selection.Row
Range("A1").CurrentRegion.Interior.Color = xlNone
Range("A" & sor & ":I" & sor).Interior.Color = vbYellow
B = Cells(sor, "B")
C = Cells(sor, "C")
E = Cells(sor, "E")
F = Cells(sor, "F")
I = Cells(sor, "I")
MsgBox B & vbLf & C & vbLf & E & vbLf & F & vbLf & I
End SubAz üzenet (Msgbox) helyett műveleteket végezhetsz az aktív sor celláinak az értékével.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
CséGyé
csendes tag
Excel 2016
Üdv! Segítséget szeretnék, mint kezdő Excel felhasználó, Excel 2016 táblázat ügyben.
Megpróbálom röviden és érthetően írni a kérésemet.Munka1 lapon A1-A200-ig nevek vannak.
Azt kellene megoldanom, hogy a Munka2 lapon F5-ös cellából tudjam ezeket a neveket lista szerűen kiválasztani, de kiválasztás után a Munka2 B5-ös cellában jelenjen meg amit, kiválasztok nevet.
És ami fontos, hogy a Munka2 lapon B5-ös cellába nem lehet semmi függvény, képlet.
Előre is köszönöm. -
tzimash
őstag
Van ez a for ciklus:
For sor = usor To 2 Step -1
If Cells(sor, "H").Value = "C" And Cells(sor, "J").Value < "30" Then
Rows(sor).Delete Shift:=xlUp
End If
NextSzépen törli azokat a sorokat, ahol H oszlopban a cella értéke "C" és a J oszlopban a cella értéke kisebb, mint 30, ha 31 vagy nagyobb, akkor a sorokat meghagyja, egészen 99-ig. Ha a J oszlopban a cella értéke 100 vagy annál nagyobb, akkor megint törli a sorokat...
Miért megy be ekkor a ciklusmagba az istenadta? -
CséGyé
csendes tag
Itt a fórumon egy segítőtől kaptam ezt a kódot. Működik is jól
=HAHIBA(INDEX($E$7:$E$24;HOL.VAN(SEGÉDLET!$A$33;SEGÉDLET!AG7:AG24;0)-1;1);"")
Ahol a $A$33 van ott egy szám található és nekem ezt kellett kerestetnem.
Bele lehet ebbe írni, még egy keresést? hogy, ezt is keresse $A$34 -
Delila_1
Topikgazda
válasz tzimash #37686 üzenetére
Ha a J oszlopban számok vannak, ne tedd idézőjelek közé a 30-at a feltételben, mert akkor szövegként értelmezi. A "100" kisebb, mint a "30", viszont a 100 nagyobb 30-nál.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
CséGyé
csendes tag
HAHIBA(INDEX($E$7:$E$24;HOL.VAN(SEGÉDLET!$A$33;SEGÉDLET!AG7:AG24;0)-1;1);"")
Eddig így működött, azaz működik is.
Ami a lényeg, hogy a $A$33 cellában van egy szám, amit nagyon jól működően kezel is.
De most a használat közben kiderült, hogy kellene még egy szám és kezelje azt is azaz vegye figyelembe.
Ezért létre hoztam egy általam másik figyelt számot, amit itt keressen,
$A$31Ha értenék hozzá pontosabban írnám le, tudom ez így nem jó, de valami ilyesmire gondoltam:
HAHIBA(INDEX($E$7:$E$24;HOL.VAN(SEGÉDLET!$A$33 ÉS $A$31;SEGÉDLET!AG7:AG24;0)-1;1);"")
Tehát a kérdésedre a válaszom: És
-
-
RAiN91
őstag
válasz Delila_1 #37677 üzenetére
Külső oldalról másolom be az adatokat, és alapból dátum formátumot ad. Ha előtte a cellát átrakom szám formátumra, akkor is felülírja, és dátumnak nézi. Ezt hogy lehet átállítani? (utólag állítom, akkor nem jó, dátumot adja meg számmá, és nem az volt előtte)
[ Szerkesztve ]
-
d@minator
addikt
Hi! Megcsináltam ezt: [link] és működik de ha beszínezek valamit nem változik semmi csak az újraszámolásra rányomva. Hogyan lehet megoldani, hogy a cellaszín változására is működjön vagy pedig az újraszámolás automatikus és gyakori legyen? Az autó újraszámolás be van kapcsolva.
Nem értek hozzá ez az első ilyenem. -
Fferi50
őstag
válasz d@minator #37699 üzenetére
Szia!
"de ha beszínezek valamit nem változik semmi csak az újraszámolásra rányomva."
Pontosan ezt mondja a makróhoz fűzött kiegészítés:
"Note: If after applying the above mentioned VBA code you would need to color a few more cells manually, the sum and count of the colored cells won't get recalculated automatically to reflect the changes. Please don't be angry with us, this is not a bug of the code : )
In fact, it is the normal behavior of all Excel macros, VBA scripts and User-Defined Functions. The point is that all such functions are called with a change of a worksheet's data only and Excel does not perceive changing the font color or cell color as a data change. So, after coloring cells manually, simply place the cursor to any cell and press F2 and Enter, the sum and count will get updated. The same applies to the other macros you will find further in this article. "
Nincs más hátra, mint előre, mindig újra kell számoltatnod a színezés után, mert az Excelnek nincs a színváltozást érzékelő eseménye.
Üdv.
Új hozzászólás Aktív témák
- Alapértelmezett konfiguráción sok Core CPU-nak lehet stabilitási gondja
- Politika
- Spórolós topik
- Xiaomi 13T és 13T Pro - nincs tétlenkedés
- Elektromos autók - motorok
- Társasjáték topic
- Hálózati / IP kamera
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- exHWSW - Értünk mindenhez IS
- Fortnite - Battle Royale & Save the World (PC, XO, PS4, Switch, Mobil)
- További aktív témák...
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: Ozeki Kft.
Város: Debrecen