-
Fototrend
Fototrend
Új hozzászólás Aktív témák
-
tzimash
őstag
Hali,
így néz ki a táblázatom:
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?
-
p5quser
tag
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!
-
Pakliman
tag
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 Thensor 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.: egy Select Casevá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). -
Pakliman
tag
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
-
p5quser
tag
Ü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!
-
scott_free
senior tag
Végül megtaláltam a választ rá, hátha másnak is hasznos:
Application.Calculation = xlCalculationManual
‘Place your macro code here
Application.Calculation = xlCalculationAutomaticÍgy most 10 perc helyett 10 másodperc alatt végez!
-
Oldman2
nagyúr
-
#62169858
törölt tag
Üdv! Megoldást keresek egy (Excel 2016) táblázat napi kimutatásához.
Példa a mellékelt képernyőfotón jól látható.
Itt a megoldásnak annak kellene lenni, hogy a D11-es cellába Béla a D12-es cellába Tamás név szerepeljen.
Tehát egy függvény keresse meg hol szerepel az általam megadott szám, jelen esetben 5-ös és annak a nevét írja ki. Egy napon egy táblázatban soha nem szerepel többszőr az 5-ös, így nem gond, ha az első megtalált 5-ös szám melletti nevet írja ki. Az FKERES-el próbálkoztam, de nem tudtam megoldani, hogy minden második sort vegye csak figyelembe a keresésénél.
Aki tudna rá megoldást írna nekem egy pontos függvényt?
Kezdő vagyok, nem szégyellem. -
scott_free
senior tag
Sziasztok,
van egy vba-makróm, ami cellákba ír be képleteket (az oszlopoknak megfelelő kódokkal) - normális az, hogy 100 cellával kb. 10 percig szöszmötöl? (6 magos procival, Excel 2016)
Vagy esetleg én írtam vmit rosszul?Ez a vba-rész csinálja:
Application.AutoCorrect.AutoFillFormulasInLists = False
For k = 99 To 135 Step 3
If k < 121 Then
aWs.Cells(aRow, 9 + k).Formula = "=IFERROR(ROUND($G" & aRow & "*D" & Chr(k - 30) & aRow & ",2),"" "")"
Else
aWs.Cells(aRow, 9 + k).Formula = "=IFERROR(ROUND($G" & aRow & "*E" & Chr(k - 56) & aRow & ",2),"" "")"
End If
str = aWs.Cells(2, 10 + k).Value
aWs.Cells(aRow, 10 + k).Formula = "=INDEX(a.sz[" & str & "]," & j & ")"
Next kMitől lehet ilyen lassú?
-
Oldman2
nagyúr
-
ny.janos
tag
Köszönöm, hogy foglalkoztál vele, már csak azért is, mert ha időközben nem jöttem volna rá, hogy hogyan használjam az INDIREKT függvényt, a megoldásod alapján biztosan megértettem volna (pedig már korábban is próbálkoztam vele, csak rosszul).
Nem sokkal a hozzászólásod előtt jöttem rá kettő lehetséges megoldásra is, amint azt látod eggyel a válaszod előtt.A MEDIÁN-os megoldásod sajnos nem jó esetemben, mert egy terméknek 3 vagy több időszaki ára is lehet, így eredményként nem jó az első vagy utolsó időszaki ár (lehet, hogy nem sikerült egyértelműen megfogalmazni a kérdésemet).
A te megoldásodban C13 cella értéke 499 (2017.01.31.), pedig a "Termék3"-nak nevezett termék ára 2017.01.01-től 624. Vagyis eredményként azt kell kapjam.
-
ny.janos
tag
Sziasztok!
Bár kerülő megoldással már megoldottam a problémámat, amivel kapcsolatban kérdezni szeretnék, de továbbra sem hagy nyugodni, hogy csak én vagyok hozzá „kevés”, vagy képlettel ezt nem is lehet megoldani (makró megoldás köszönöm nem érdekel, csak képletben gondolkodom).
Adott egy táblázat – nevezzük 1. táblázatnak – (az alább képen pirossas színnel jelölve), amelyben egy adott termékhez tartozó időszaki árat keresek. Egy másik táblázatban – legyen ez 2. számú táblázat – (kék színnel jelölve) valamennyi termék valamennyi időszaki ára szerepel (az időszakok nem egyforma hosszúak, és termékenként eltérő számú időszaki ár van).
Az FKERES függvény ugye csak 1 feltétel szerint tud keresni. Ha nem dátum lenne az egyik keresési feltétel, akkor A-B illetve E-F oszlopokat összefűzve tudnék 2 feltételre keresni, de a dátumra vonatkozó közelítő keresés miatt ez esetemben nem lehetséges. (Itt jegyezném meg, hogy a kerülő megoldásom az volt, hogy minden egyes napra előállítottam az éppen érvényes árat, és az összefűzött értékre kerestem – így ez a megoldást már nem keresem.)
Az elvi megoldásom az volt, hogy a keresendő termék 2. számú táblázatban lévő helyzetét (-tól / -ig sorait) a HOL.VAN illetve a DARABTELI függvények segítségével megkeresem, majd az így kapott sorokat használom fel tartományként az FKERES függvényben.
C2 cella képlete, az elvi megoldásomban:
=FKERES(B2;ÖSSZEFŰZ("$F$";HOL.VAN(A2;$E$1:$E$8;0);":$G$";DARABTELI($E$1:$E$8;A2)+HOL.VAN(A2;$E$1:$E$8;0)-1);2;1)
Az eredmény azonban „ÉRTÉK!” hiba.
A képletből a tartományra vonatkozó függvény:
ÖSSZEFŰZ("$F$";HOL.VAN(A2;$E$1:$E$8;0);":$G$";DARABTELI($E$1:$E$8;A2)+HOL.VAN(A2;$E$1:$E$8;0)-1)
annak eredménye:
"$F$2:$G$3"
Vagyis az eredmény jó lenne, ha nem lenne ott az idézőjel.A kérdés adott: a probléma orvosolható valahogy?
-
Oldman2
nagyúr
-
Cece04
tag
Ehhez kapcsolódó, egyszerűbb picit, mint az előző, de nem jövök rá.
Azt szeretném,hogy csak akkor lehessen kiválasztani a legördülőből az "IGEN"-t,
ha van valamilyen összeg beírva a mellette lévő cellába. Tehát,ha üres az a cella, akkor hibaüzenetet küldjön vissza, hogy ez így nem jó. Ez lehetséges?
Köszi szépen előre is!
-
Cece04
tag
Sorry,de azt kifelejtettem,hogy az első oszlopban több tíz különböző ország/varos van még Barcelonan kívül.
Az lenne a lényeg,hogy az összes olyan sor,aminél megegyezik az első oszlop tartalma (Itt Példában Barcelona) ott ne lehessen beállítani eltérő időpontot.
Az időpontnak meg kell valamihez igazodnia, így az "indulás" lenne a támpont, tehát az összes sornak azt a dátumot kell hoznia ami az indulás mellett van.Ezeket az adatokat nem én fogom felvinni, azért lenne jó,ha figyelmeztetné egyből a használót ,hogy vmi.hibas ,mert az indulástól eltérő dátumra akar valamit felvinni.
Köszi
-
Bati0501
őstag
Sziasztok!
2010-es excel ezt írja ki, amikor pivot táblát akarok csinálni: "A kimutatás egyik mezőneve érvénytelen. Kimutatás létrehozásához lista vagy feliratozott oszlopok formájában rendezett adatokat kell használnia. Kimutatásmező nevének módosításakor be kell írnia a mező új nevét."
Lassan fél órája próbálkozok, átszerkesztettem az oszlopok nevét is már, mert eddig volt benne egy jó pár cellaegyesítés is, de nem oldotta meg.
Most így néz ki, még több oszlop van, csak az már nem fért ki a képernyőre, de az most nem is érdekes:
Tudnátok tanácsot adni, hogy mit csináljak?
), akkor más szisztéma szerint kell megtalálnod, hogy az a munkalap kell-e neked (Pl.: egy 
Üdv! Megoldást keresek egy (Excel 2016) táblázat napi kimutatásához.
Új hozzászólás Aktív témák
- Játékkulcsok olcsón: Steam, Uplay, GoG, EA, Xbox stb.
- MEGA AKCIÓ! - Jogtiszta Windows - Office & Autodesk & CorelDRAW - Azonnal - Számlával - Garanciával
- MS SQL Server 2016, 2017, 2019
- Microsoft Office 2024 Home Business dobozos
- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- iPhone 17 Pro 256 GB Silver - Bontatlan !! www.stylebolt.hu - Apple eszközök - Számlás
- Mini Pc HP ProDesk 600 G4 / EliteDesk 800 G5 // 6-9. gen // i3 / i5
- Dell Latitude 5430 14" Touchscreen i5-1235U 16GB 1000GB 1 év garancia
- HIBÁTLAN iPhone 15 Pro 128GB Natural Titanium -1 ÉV GARANCIA - Kártyafüggetlen, MS4538
- iPhone 17 Pro 256 GB Kozmosz - Bontatlan !! www.stylebolt.hu - Apple eszközök - Számlás
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest