- Samsung Galaxy S23 Ultra - non plus ultra
- Yettel topik
- Sokat fejlődött a Tecno belépő ajánlata
- Samsung Galaxy Watch7 - kötelező kör
- Íme az új Android Auto!
- Xiaomi 14T Pro - teljes a család?
- Megjelent a Poco F7, eurós ára is van már
- Motorola Edge 50 Neo - az egyensúly gyengesége
- Leica kamerákat kap a Xiaomi Mix Flip 2 is
- Samsung Galaxy Watch6 Classic - tekerd!
-
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
-
p5quser
tag
Sziasztok!
Hogy tudnék ebben a sorban
ActiveSheet.Cells(2, x + 2).Formula = "=RC[-1]*2222222"
"2222222" helyett a
=(INDEX('sheet2'!$A$1:$N$400,MATCH(A2,'sheet2'!$B$1:$B$400,0),12),""0"")
képlet eredményére hivatkozni? Sheet2 neve változik, azért nem jó, ha csak azt írnám be a makróba.
Run-time 1004
ap-def, or obj-def a hibaüzenet. -
p5quser
tag
Esetleg arra nincs valakinek tippje, hogy ezt;
For i = 2 To Sheets.Count
Cells(2, i).Formula = "=INDEX('" & Sheets(i).Name & "'!$A$1:$N$400,MATCH(A2,'" & Sheets(i).Name & "'!$B$1:$B$400,0),11)"
Next ihogyan házasítsam egy autofill-lel, hogy a cellát végighúzza az oszlopon?
Köszönöm! -
p5quser
tag
#nevergiveup
Sziasztok!
=INDEX('rakat1'!$A$1:$N$400;HOL.VAN(A2;'rakat1'!$A$1:$N$400;0);11)
Ez miért "hiányzik"-kal dobál engem, amikor mindkét táblában ott vannak az adatok?
Az első munkalap A2-es cellájában van a keresési érték megadva (szöveg) és a rakat1-ből szeretném kikeresni az ehhez az értékhez tartozó sor 11. oszlopának metszetét.
Ctrl-F-re behozza mindkét lapon, tehát a keresési érték helyes.
Köszönöm. -
p5quser
tag
#mithittem
Sziasztok!
Ismét.Dim rngA As Range
Dim rngB As Range
Dim intI As Integer
Set rngA = ws.Range("B1:B400")
Set rngB = act.Range("A1:A400")
For intI = 400 To 1 Step -1
If Application.WorksheetFunction.CountIf(rngB, rngA.Cells(intI)) = 0 Then
rngA.Cells(intI).Delete Shift:=xlUp
End If
Next intIEzt az izékét hogyan kell úgy módosítani, hogy ne törölje a cella tartalmát, hanem hogy másolja ki B-ből és szúrja be A-ba, egy sor "letolással", megegyező sorba?
Köszönöm! -
p5quser
tag
#36961 Pakliman
#36962 Delila_1
Mindkettőtöknek köszönöm, mindkettő jól működik!
Ráadásul minkettő tanít, ami jól jön a következő lépésekhez.
Mégegyszer köszönöm!Pakliman, remélem kódolgatsz a dokinál, nincs baj.
-
p5quser
tag
válasz
Delila_1 #36956 üzenetére
Szia!
Először is köszönöm.
Nem igazán tudom beszúrni, vagy nem ilyen formában kellene utasítani, vagy passz...
Az első munkalapon lévő gombhoz van rendelve ez a makró. Lefut, de csak azon a munkalapon, amelyiken futtatom a "debug" ablakból. Valamint az első munkalapon elszáll hibával, mert nem úgy néz ki mint a többi.Sub CommandButton2_Click()
'Kijelölés
ActiveSheet.Range("$A$1:$N$330").AutoFilter Field:=11, Criteria1:=">1", _
Operator:=xlAnd
ActiveSheet.AutoFilter.Range.Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 5296274
.TintAndShade = 0
.PatternTintAndShade = 0
End With
ActiveSheet.ShowAllData
ActiveSheet.Range("$A$1:$N$330").AutoFilter Field:=11, Criteria1:="<-1", _
Operator:=xlAnd
ActiveSheet.AutoFilter.Range.Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
End With
ActiveSheet.ShowAllData
ActiveSheet.Range("$A$1:$N$316").AutoFilter Field:=11, Criteria1:=">1", _
Operator:=xlOr, Criteria2:="<-1"
End SubEnnek a makrónak kéne lefutnia az összes munkalapon (kivéve az elsőt) a munkafüzetben, ha klikkelnek a gombra.
-
p5quser
tag
Sziasztok!
Azt meg tudnátok mutatni hogy ezt;Selection.AutoFilter
ActiveSheet.Range("$A$1:$N$316").AutoFilter Field:=11, Criteria1:=">1", _
Operator:=xlOr, Criteria2:="<-1"hogy tudom kiterjeszteni az összes munkalapra, kivéve az elsőt?
Előre is köszönöm! -
p5quser
tag
Sziasztok!
Esélyem sincs...
Arra össze tudnátok dobni egy szkriptet, hogy;
Egy munkafüzet összes munkalapjának (az első kivételével) "K" oszlopában lévő 1< számokat tartalmazó sorokat zölddel, a -1> számokat tartalmazó sorokat pedig pirossal kijelölje?
Ha ez valakinek kisujjból kiröppen, akkor megkérném arra is, hogy esetleg ezeket a színezett sorokat (illetve "B" és "K" oszlop-metszetüket, valamint külön cellába a munkalap nevét hozzáfűzve) másolja be az első munkalapba?
Az első munkalapba másolt adatok színenként "tömbösülnének".
Ilyesmire gondoltamTermészetesen megértem, ha valaki kisujj helyett a középső ujjából próbálja kirázni kérésem
, ebben az esetben -kérem- vezessen végig a lépéseken, mint egy kétévest.
Köszönöm! -
p5quser
tag
Sziasztok!
Azt hogy lehet ebben a scriptben megoldani, hogy a megnyitott excel fájlok neve legyen a munkalapok neve?
A pár hsz.-sal feljebbi kérdésemhez kapcsolódik a téma.
Előre is köszönöm!Sub CommandButton1_Click()
Dim fnameList, fnameCurFile As Variant
Dim countFiles, countSheets As Integer
Dim wksCurSheet As Worksheet
Dim wbkCurBook, wbkSrcBook As Workbook
fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)
If (vbBoolean <> VarType(fnameList)) Then
If (UBound(fnameList) > 0) Then
countFiles = 0
countSheets = 0
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wbkCurBook = ActiveWorkbook
For Each fnameCurFile In fnameList
countFiles = countFiles + 1
Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)
For Each wksCurSheet In wbkSrcBook.Sheets
countSheets = countSheets + 1
wksCurSheet.Copy after:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
Next
wbkSrcBook.Close SaveChanges:=False
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Procesed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
End If
Else
MsgBox "No files selected", Title:="Merge Excel files"
End If
End Sub -
p5quser
tag
Ráleltem... Hátha másnak is jól jön. A VBA-s hókusz-pókusz megteszi amire kérem.
-
p5quser
tag
Sziasztok!
Hogyan lehet megnyitni több excel fájlt úgy, hogy egy excel munkafüzet munkalapjaiként jelenjenek meg? A copy-paste kissé körülményes lenne 30-akárhány munkafüzetből. Az így megnyitott összes munkalap adott oszlopainak értékeit szeretném kinyerni az első munkalapon. Vba-zni kell, vagy van erre valami égetett megoldás az excelben?
Előre is köszönöm! -
p5quser
tag
válasz
Delila_1 #36660 üzenetére
Ha lehet, elmennék a falig...
Ha azt szeretném, hogy csak a kimásolt cella értékét másolja be az adott helyre? Mivel most a teljes cella formátumot beilleszti. Valami PasteSpecial-lal kisérleteztem, de aztán azt is elengedtem....Ha esetleg épp a körmöd piszkálgatnád...
-
p5quser
tag
Sziasztok!
A segítségeteket szeretném kérni.
Az alábbi DoubleClick2Copy makró tökéletesen működik, de mindig ugyanabba a cellába illeszti be a komplett cellát.
Azt szeretném elérni, hogy a "cikkek" munkalap A oszlopából, a "Szlazo" munkalap A oszlopának 2. cellájától lefelé haladva, a következő üres cellába illessze be csak az értéket.
Ezután ugorjon a "Szlazo" munkalapban arra a cellára, ahová bemásolta az értéket, majd váltsa át az aktív cellát 2-vel jobbra, az adott sorban.Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A1:A2637")) Is Nothing Then
Cancel = True
Target.Copy Destination:=Sheets("Szlazo").Range("A2")
Sheets("Szlazo").Select
ActiveCell.Offset(0, 2).Select
End If
End SubCopy-paste guy vagyok, bármiféle előképzettség nélkül, kényszer szülte megoldás ez az excel tábla, ezért a kész kódnak venném igazán hasznát.
Előre is köszönöm!
Új hozzászólás Aktív témák
Hirdetés
- Samsung Galaxy S23 Ultra - non plus ultra
- Hobby rádiós topik
- AMD Ryzen 9 / 7 / 5 9***(X) "Zen 5" (AM5)
- Yettel topik
- Kínai és egyéb olcsó órák topikja
- BMW topik
- A látszat ellenére helyesen működik az NVIDIA-féle Resizable BAR implementáció
- The Division 2 (PC, XO, PS4)
- Anglia - élmények, tapasztalatok
- Kerékpárosok, bringások ide!
- További aktív témák...
- ROBUX ÁRON ALUL - VÁSÁROLJ ROBLOX ROBUXOT MÉG MA, ELKÉPESZTŐ KEDVEZMÉNNYEL (Bármilyen platformra)
- Gyermek PC játékok
- Kaspersky, McAfee, Norton, Avast és egyéb vírusírtó licencek a legolcsóbban, egyenesen a gyártóktól!
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - NYÁRI AKCIÓ!
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Csere-Beszámítás! Asztali számítógép PC Játékra. I5 12400F / RTX 3070 / 32GB DDR4 / 1TB SSD
- AKCIÓ! MSI B450M R5 5600X 32GB DDR4 512GB SSD RTX 3060 12GB Rampage SHIVA Zalman 600W
- MacBook, Apple M1 / M2 kompatibilis dokkolók, DisplayLink 4K, USB-C, Type-C
- ÁRGARANCIA! Épített KomPhone Ryzen 7 9700X 32/64GB RAM RX 9070 16GB GAMER PC termékbeszámítással
- Bomba ár! Fujitsu LifeBook U758 - i5-8GEN I 8GB I 256GB SSD I HDMI I 15,6" FHD I W11 I Garancia!
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: CAMERA-PRO Hungary Kft
Város: Budapest