-
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
-
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
- MWC 2026: Bajnoki címre pályázik a Xiaomi Watch 5
- Autós topik
- Gitáros topic
- Debrecen és környéke adok-veszek-beszélgetek
- AliExpress tapasztalatok
- WoW avagy World of Warcraft -=MMORPG=-
- PROHARDVER! feedback: bugok, problémák, ötletek
- Ubiquiti hálózati eszközök
- sziku69: Fűzzük össze a szavakat :)
- Elektromos rásegítésű kerékpárok
- További aktív témák...
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Game Pass Ultimate előfizetések 1 - 36 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN! AKCIÓ!
- MS SQL Server 2016, 2017, 2019
- MEGA AKCIÓ! - Jogtiszta Windows - Office & Autodesk & CorelDRAW - Azonnal - Számlával - Garanciával
- Vírusirtó, Antivirus, VPN kulcsok GARANCIÁVAL!
- Beszámítás! MSI Gaming Cyborg A15 FHD Gamer notebook - R5 240 16GB DDR5 512GB SSD RTX 5050 8GB
- Apple iPhone 13 128GB,Átlagos,Adatkabel,12 hónap garanciával
- Tekken 7 Playstation 4
- ÁRGARANCIA!Épített KomPhone i5 14600KF 32/64GB RAM RX 9070 16GB GAMER PC termékbeszámítással
- Akció!!! Microsoft Surface Laptop 4 13.5" i7-1185G7 16GB 512GB 1 év garancia
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest



