- Biztonsági aggályok miatt késik a Microsoft hatalmas AI-újítása
- Kíváncsi az EU, milyen online védelmet adnak a pornóplatformok a kiskorúaknak
- Panaszt tettek a Google ellen, mert követi a felhasználókat a böngészője
- Rengeteg áram kell az adatközpontoknak, erre válasz a geotermikus energia
- Az AI megmondja, hogy van-e fájdalma a macskának
- Vodafone otthoni szolgáltatások (TV, internet, telefon)
- Sweet.tv - internetes TV
- Alternatív kriptopénzek, altcoinok bányászata
- Facebook és Messenger
- Betelik a pohár: nagy igény lenne a gyorshajtás-ellenes technológiára
- Max
- DIGI kábel TV
- Biztonsági aggályok miatt késik a Microsoft hatalmas AI-újítása
- Az AI miatt vehetnek sokan új iPhone-t
- Ubiquiti hálózati eszközök
-
IT café
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
-
Delila_1
Topikgazda
válasz
Fferi50 #26150 üzenetére
Van táblázat a 2003-ban, sőt előtte is, csak ott listának nevezték.
Eddig úgy tudtam, az a lényeg ennél a szűrésnél, hogy megegyezzenek a mezőcímek, de látod, Hhheninél összejött.
"...úgy tudtam megoldani, hogy fölvettem egy "többet" nevű fiktív mezőt, alá d2<k2, és tökéletesen működik"
Nálam az ab.darab2(...) sem jött így össze.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
hhheni
tag
válasz
Fferi50 #26150 üzenetére
sziasztok
nem úgy tűnik, hogy ez csak nálam működne, rákerestem egy picit:
[link]
213. oldalon, "képlet" és "logikai"[link]
"felt_1" (itt egyébként megtaláltam arra a kérdésre a megoldást, amelyikben Delila segített)ugyanez videón (itt van egy "felt_2" is):
[link][link]
65. oldal, a hozzá tartozó példa megoldással együtt:[link]
(itt üresen hagyja, de kitöltve is működik)[ Szerkesztve ]
-
Fferi50
őstag
válasz
Delila_1 #26155 üzenetére
Szia!
Most nekem is összejött. Szerintem az a "siker kulcsa", hogy "simán" csak a kifejezést kell beírni képletként, azaz egyenlőségjellel kezdve. Ekkor megjelenik a kifejezés eredménye a kritérium cellában. (Tehát pl. =B2=C2 - ami igaz/hamis -ként jelenik meg- és nem ="=B2=C2", ami =B2=C2 -ként jelenik meg a cellában.)
Üdv.
(Az a szép az ilyen fórumokban, hogy mindig tanul az ember valami újat és hasznosat.)
-
Delila_1
Topikgazda
-
hhheni
tag
válasz
Delila_1 #26159 üzenetére
most végignéztem a videót, én ilyesmit 2:00 körül találtam, az viszont - az ő szavával élve - az "autofilterre" vonatkozik, és én úgy gondolom, hogy ebben igaza is van: autoszűrő esetén én csak a saját oszlopára vonatkozó feltételeket tudok megadni
irányított szűrővel persze pontosan úgy van, ahogy mutattad
-
bteebi
veterán
Sziasztok!
Van egy file-om egy modulban lévő makróval. A file különböző - de megegyező struktúrájú - lapjaira szeretnék más Excel file-okból adatokat bemásolni. A másolandó adatokon minimális változtatást végeznék: az eredeti adatok általános formátuma pl. "3.2k", ezt - az utolsó karakter levágása után - felszorzom 1000-rel, és azt szeretném bemásolni, a számformátumot "0"-ra állítva.
Összességében egy dialógusablakkal szeretném megnyitni az adatforrásként szolgáló file-t, viszont nem tudom, hogy hogyan kell(ene) meghivatkozni ahhoz, hogy menjen a másolás.
A jelenlegi makró:
Sub kitoltes()
Dim ablak As FileDialog, fajlnev As String, FileChosen As Integer
Set ablak = Application.FileDialog(msoFileDialogOpen)
FileChosen = ablak.Show
ablak.Title = "Válaszd ki az importálandó file-t"
ablak.InitialFileName = ActiveWorkbook.Path
ablak.InitialView = msoFileDialogViewList
ablak.Filters.Clear
ablak.Filters.Add "Excel 2003 worksheet", "*.xls"
ablak.Filters.Add "Excel 2010 worksheet", "*.xlsx"
ablak.Filters.Add "Excel makró", "*.xlsm"
ablak.FilterIndex = 1
If FileChosen = -1 Then
fajlnev = ablak.SelectedItems(1)
Workbooks.Open (fajlnev)
Else: Exit Sub
End If
Dim adat As Integer, oszlop As Integer
For adat = 1 To 10
For oszlop = 2 To 10 Step 4
'ebben a sorban valószínűleg több hiba is van:
ActiveSheet.Cells(19 + 2 * adat, oszlop) = 1000 * (Left(fajlnev.Sheets("Sheet1").Cells(36 + 2 * (adat - 1), 16), Len(fajlnev.Sheets("Sheet1").Cells(36 + 2 * (adat - 1), 16) - 1)))
ActiveSheet.Cells(19 + 2 * adat, oszlop).NumberFormat = "0"
Next oszlop
Next adat
End SubHa benne van az 1000-rel való szorzás, akkor "Type mismatch" hibát dob, ezért jobb híján beszúrtam egy plusz sort, így már legalább az a része működik:
ActiveSheet.Cells(19 + 2 * adat, oszlop) = ActiveSheet.Cells(19 + 2 * adat, oszlop) * 1000Tudnátok segíteni a hibák kijavításában? Előre is köszönöm!
Cancel all my meetings. Someone is wrong on the Internet.
-
Fferi50
őstag
válasz
bteebi #26162 üzenetére
Szia!
Az világos, hogy honnan szeretnél másolni, az viszont nem egészen, hogy hova.
Mert a "forrás" munkafüzet megnyitása után az abban levő munkalap válik aktívvá, tehát az itt
" For oszlop = 2 To 10 Step 4
'ebben a sorban valószínűleg több hiba is van:
ActiveSheet.Cells(19 + 2 * adat, oszlop) = 1000 * (Left(fajlnev.Sheets("Sheet1").Cells(36 + 2 * (adat - 1), 16), Len(fajlnev.Sheets("Sheet1").Cells(36 + 2 * (adat - 1), 16) - 1)))
ActiveSheet.Cells(19 + 2 * adat, oszlop).NumberFormat = "0"
Next oszlop"
hivatkozott Activesheet sajnos a forrás fájlodban van.Tehát ebben az esetben neked nem a forrás fájl hivatkozással van problémád, hanem a cél fájl hivatkozásával.
Ezt pedig úgy tudod megoldani, hogy az "eredeti" munkafüzeted kitöltendő munkalapját (amiből a többit megnyitod), egy változóhoz rendeled mielőtt még egy másik fájlt megnyitnál (pl.Set cellap=activesheet), mivel most még az az aktív munkalap.
Ezek után a számolás: cellap.cells(19+2*adat,oszlop) -ra kell hogy hivatkozzon és persze akkor fajlnev.sheets("Sheet1").cells helyett maradhat az Activesheet.cells."az eredeti adatok általános formátuma pl. "3.2k"" Ez azt jelenti, hogy mindig van a szám után egy betű és a formátum szöveg?
Ha igy van, akkor a használható a replace függvény is: replace(activesheet.cells(36+2*(adat-1),16),right(activesheet.cells(36+2*(adat-1),16),1),"").
Viszont a "beszúrt" programsorból úgy látom, az eredeti érték számformátum, ezért működik a közvetlen szorzás 1000-el, vagyis nem kell semmilyen levágás, átalakítás!Még valami: ahol Activesheet.Cells van, ott az Activesheet elhagyható, mert az az alapértelmezés.
Üdv.
[ Szerkesztve ]
-
bteebi
veterán
válasz
Fferi50 #26163 üzenetére
Szia!
"Ez azt jelenti, hogy mindig van a szám után egy betű és a formátum szöveg?"
Basszus, igazad van (ebben is)!
Minden bizonnyal emiatt nem ment a szorzás, mert az eredeti cella szöveg formátumú volt (vagyis általános). Viszont valamiért az adatmásolás továbbra sem megy. Szerintem itt van a probléma, valószínűleg a "fajlnev" (vagy épp a "cellap") miatt:
Set cellap = ThisWorkbook.ActiveSheet
...
cellap.Cells(19 + 2 * adat, oszlop) = Left(fajlnev.Sheets("Sheet1").Cells(36 + 2 * (adat - 1), 16), Len(fajlnev.Sheets("Sheet1").Cells(36 + 2 * (adat - 1), 16) - 1))A végén pedig szeretném bezárni a megnyitott file-t, de a Workbooks.Close (fajlnev) paranccsal nem megy, pedig a Workbooks.Open (fajlnev) parancsra megnyitja
.
Cancel all my meetings. Someone is wrong on the Internet.
-
Fferi50
őstag
válasz
bteebi #26165 üzenetére
Szia!
Milyen hibát ír ki? Szerintem továbbra is az a baj, hogy nem szövegformátumból akarsz szöveget kivágni a left és len függvényekkel. Ez mire lenne jó?
De a fajlnev is okozhat problémát, mivel az egy szöveges (string) változó és nem objektum.
Ezért így kell használni Workbooks(fajlnev).Sheets("Sheet1"), de a szituációból kiindulva írhatod így is Activeworkbook.Sheets("Sheet1") (mivel megnyitás után ez lesz az aktív munkafüzet).A munkafüzet bezárása is hasonló: Workbooks(fajlnev).Close Savechanges:=False ez utóbbi paraméter alapján nem menti a változásokat és nem is kérdez rá, hogy szeretnéd-e menteni (nem is kell, hiszen a forrásfájlt nem változtatod).
Üdv.
[ Szerkesztve ]
-
bteebi
veterán
válasz
Fferi50 #26166 üzenetére
Szia!
Közben elég sokféleképp próbálkoztam. A jelenlegi változatnál "Subscript out of range" hibaüzenetet dob ennél a sornál:
cellap.Cells(19 + 2 * adat, oszlop) = Left(Workbooks(fajlnev).Sheets("Sheet1").Cells(36 + 2 * (adat - 1), 16), _
Len(Workbooks(fajlnev).Sheets("Sheet1").Cells(36 + 2 * (adat - 1), 16) - 1))Sub masol()
Set cellap = ThisWorkbook.ActiveSheet
Set ablak = Application.FileDialog(msoFileDialogOpen)
ablak.Filters.Clear
ablak.Filters.Add "Excel fájlok", "*.xls, *.xlsx, *.xlsm"
ablak.Filters.Add "Excel 2003 worksheet (.xls)", "*.xls"
ablak.Filters.Add "Excel 2010 worksheet (.xlsx)", "*.xlsx"
ablak.Filters.Add "Excel makró (.xlsm)", "*.xlsm"
ablak.FilterIndex = 1
FileChosen = ablak.Show
ablak.Title = "Válaszd ki a file-t"
ablak.InitialFileName = ThisWorkbook.Path
ablak.InitialView = msoFileDialogViewList
If FileChosen = -1 Then
fajlnev = ablak.SelectedItems(1)
Workbooks.Open (fajlnev)
Else: Exit Sub
End If
For adat = 1 To 10
For oszlop = 2 To 10 Step 4
cellap.Cells(19 + 2 * adat, oszlop) = Left(Workbooks(fajlnev).Sheets("Sheet1").Cells(36 + 2 * (adat - 1), 16), _
Len(Workbooks(fajlnev).Sheets("Sheet1").Cells(36 + 2 * (adat - 1), 16) - 1))
cellap.Cells(19 + 2 * adat, oszlop) = cellap.Cells(19 + 2 * adat, oszlop) * 1000
cellap.Cells(19 + 2 * adat, oszlop).NumberFormat = "0"
Next oszlop
Next adat
Workbooks(fajlnev).Close savechanges:=False
End SubHa az End If az utolsó előtti sorban van, akkor lefut a kód, csak nem csinál semmit; nem másol és nem zárja be a megnyitott file-t. A Workbooks(fajlnev) helyett próbálkoztam ActiveWorkbook-kal is, de úgy se ment, akkor "Type mismatch" hibaüzenetet ad.
[ Szerkesztve ]
Cancel all my meetings. Someone is wrong on the Internet.
-
Fferi50
őstag
válasz
bteebi #26167 üzenetére
Szia!
Egy apróság van benne. A fajlnev változód a megnyitott fájl teljes nevét tartalmazza és így nem találja meg a megnyitott fájlok között, mert ott viszont csak a rövid név szerepel.
Ezért be kell egy sort iktatni:
End If
fajlnev=activeworkbook.name ' ezt kell beszúrni
For adat = 1 To 10Szerintem így már mennie kell. (De a szövegfeldolgozást továbbra sem értem, hiszen egyszer már megbeszéltük, hogy a számot nem lehet szövegfüggvénnyel darabolni.)
Üdv.
[ Szerkesztve ]
-
Des1gnR
őstag
Sziasztok!
Van egy szöveges állományom amelyben termékek vannak felsorolva:
Élelmiszer
Édesség
Belvita jóreggelt 50g mézzel-mogyoróval
Nettó ár: 83 FtÉlelmiszer
Édesség
Orbit Eper 14g.
Nettó ár: 78 FtA termékek csak egyetlen üres sorral vannak elválasztva. Ezt szeretném úgy excelbe importálni, hogy minden termék új sorba kerüljön és a terméktulajdonságok külön oszlopokba.
Van ötletetek?
Dell G3 3779 || Samsung S23+ || Samsung Watch 5 Pro || Oculus Quest 2 || Creality Ender 3 V2
-
be.cool
csendes tag
Sziasztok!
Van egy markom ami azt csinálja,hogy egy adott cellába beírja az aktuális munkalap nevét, viszont nekem fordítva kéne,hogy egy adott cella alapján nevezze el a munkalapot.
Tudnátok ebben segíteni?Sub test()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Range("I7") = ws.Name
Next
End Sub -
Louro
őstag
válasz
Des1gnR #26169 üzenetére
Ha jól értem transzponálni szeretnél?
Pl.:
Élelmiszer_____________Élelmiszer
Édesség______________Édesség
Belvita jóreggelt________Orbit eper
Nettó ár______________Nettó árVagy
Élelmiszer______Édesség_____Belvita_____Nettó ár
Élelmiszer______Édesség_____Orbit_______Nettó ár(Az alsóvonások csak az olvashatóság miatt vannak
)
Ha minden termék 4 adatból áll, akkor szerencsések vagyunk, mert ciklussal gyorsan feldolgozhatóak.
Csak a kérdés, hogy a fentiből melyik kell.
Ha a 2., akkor
Sub darabolo()
Dim LastRow As Integer
LastRow = ActiveSheet.UsedRange.Rows.Count
For i = 1 To LastRow Step 5
For j = 0 To 3
'Vegye ki az első négy sort és illessze be pár oszloppal odébb.
Cells(i + j, 1).Select
Selection.Copy
Cells(i, 3 + j).PasteSpecial xlPasteValues
Next
'Az elválasztó sor miatt ugrok 5-öt.
Next
End SubMess with the best / Die like the rest
-
Louro
őstag
Hát elég gagyi megoldást találtam a gugli segítségével, de jobb, mint a semmi. Ha sűrűn kell dátum, - amit nem javaslok, mert lassít -, akkor egy változóba tedd ki egyszer és azzal dolgozz.
Forrás:[link]
Simple macro
=
Timestamp in A1 in Sheet1
=
Code:
Sub timestamp
oDoc = thiscomponent
oSheet = oDoc.Sheets(0)
oCell = oSheet.getCellRangeByName("A1")
oCell.String = oDoc.DocumentInfo.ModifyDate.Day _
& "/" & oDoc.DocumentInfo.ModifyDate.Month _
& "/" & oDoc.DocumentInfo.ModifyDate.Year _
& " " & oDoc.DocumentInfo.ModifyDate.Hours _
& ":" & oDoc.DocumentInfo.ModifyDate.Minutes
End Sub[ Szerkesztve ]
Mess with the best / Die like the rest
-
Louro
őstag
Uh, jobban megnézve a kódot szerintem csak a módosítás dátumával számol.
Mivel minden kódsor különböző időpontban fut, gondolom elég futtatásonként egyszer megnézni az időpontot. Ha kell, akkor pedig kérd le "nyugodtan" a rendszeridőt.
Na nemsokára lejár a munkaidőm....Még azt kellene megnézni, hogy magában a táblázatban van -e parancs, amivel le tudod kérni az időpontot, mint Excel esetén a =TODAY() . Ha van, akkor esetleg egy cellába tárolni :$Mess with the best / Die like the rest
-
hhheni
tag
válasz
Des1gnR #26169 üzenetére
ha nem szereted a reguláris kifejezéseket, akkor lökd be wordbe:
csere 2 db enter -> "duplaenter"
csere enter -> vessző (vagy pontosvessző)
csere "duplaenter" -> enter
és már lehet is importálni
ha a "sorvégeken" nem enter van, hanem pl. shift-enter, akkor értelemszerűen arra végzed el a cseréket
ha az árával számolni is szeretnél, akkor érdemes az importáláskor a :-ot is megadnod határolójelként -
alevan
őstag
Sziasztok. Nagy problémámmal állok elétek.
Adott sok sok excel file (összesen többszáz). Mindegyiknek a neve egy szám (0-tól 1000ig). Mindegyikből kell ugyanazokból a cellákból adat. Magyarán mindegyik excel fileból kell pl. a B2 cella tartalma, a C8 tartalma, a B15 tartalma, stb..
Namármost nekem ezeket a cellatartalmakat egy nagy excel fileba kell tennem. Vagyis, a "mester" excelben az első sorban az 1.xlsx fájlból az a B2 cella tartalma legyen az A1 cellában. A C8 cella tartalma az A2 cellában, stb.
Megcsinálnám kézzel, ha nem összesen 25 változót kellene minden excel fájlból átmásolni és ezek után ezt havonta megcsinálni.
Van-e valami megoldás arra, hogy ezt az excel automatikusan megcsinálja.
Pl. ha a "mester" xlsx fájl és a sok számozott xlsx fájl egy mappába vannak, akkor automatikusan minden változót (hisz ugyan az a koordinátája, csak más fájl) szépen sorban betesz nekem a "mester" xlsx-be?
"Ezért lovagol a pokolba a konzumer IT piac. A hülye igények... . Azt sem tudod, hogy mit akarsz de az jöjjon havonta frissités formájában."
-
Louro
őstag
válasz
alevan #26181 üzenetére
Szia,
egy gyors, esti fusimunka, de hátha használható. Ha nem megy a makrózás, akkor bocsi. Feltételezek egy kisebb hozzáértést
Főleg az adatmásolásnál lehet hasznos, bár pici logikával hamar megvan, hogy hogyan lehet A-ból B-be másolgatni.
A lentit direkt úgy csináltam, hogy a forrásokat kimented egy mappába, így az eredetik érintetlenek maradnak. A fájlokat át se kell nevezni. A lényeg, hogy .xlsx legyen a kiterjesztésük. Azokat mind bedolgozza.
SUB fajlfeldolgozo()
'A Master.xlsx legyen az asztalon.
'A forrásfájlokat másold az Asztal/Forrás mappába ;)
'Így nem kell aggódni, ha 1001 forrás van.
Dim Filename, Pathname As String
Dim SourceWorkbook As Workbook
Dim LeadFinalMsgBox As Boolean
'Hol vannak a fájlok
Pathname = ActiveWorkbook.Path & "\Forrás\"
'Ha régi formátumban vannak, akkor .xls-re írd át.
Filename = Dir(Pathname & "*.xlsx")
'Menjen végig minden fájlon
Do While Len(Filename) > 0
'Megnyitni a forrást
Workbooks.Open(Filename)
'Itt jön a másolgatás.
Range("B2").Select
Selection.Copy
Workbooks("Master.xlsx").Worksheets("Sheet1").Range(Cells(ActiveSheet.Usedrange.Rows.Count,1)).PasteSpecial xlPasteValues
Range("C8").Select
Selection.Copy
Workbooks("Master.xlsx").Worksheets("Sheet1").Range(Cells(ActiveSheet.Usedrange.Rows.Count,2)).PasteSpecial xlPasteValues
'itt akár elegánsan ciklussal is meglehetne csinálni.
'Forrásfájl törlése
Kill Pathname & Filename
'Hol vannak a fájlok
Filename = Dir(Pathname & "*.xlsx")
Loop
End SUBMess with the best / Die like the rest
-
Fferi50
őstag
válasz
alevan #26181 üzenetére
Szia!
A következő megoldást javaslom:
Sub fajlmasolo()
' A makró legyen a Master fileban, amit makróbarát fájlként kell a művelet elindítása előtt elmenteni!
' Így a Master.xlsm legyen a forrásfájlokkal egy mappában, ez a mappa mindegy, hogy hol van!.
Dim Filename As String, Pathname As String,xx as Double
Activesheet.Usedrange.Clear ' a munkalap tartalmát kitöröljük
'Hol vannak a fájlok
Pathname = ActiveWorkbook.Path
Filename = Dir(Pathname & "*.xlsx") 'Ha régi formátumban vannak, akkor .xls-re írd át.
xx = 1 'ez az első fájl helye - az első oszlop
'Menjen végig minden fájlon
Do While Len(Filename) > 0
'NEM KELL Megnyitni a forrást!!!
Cells(1, xx).Formula = "='[" & Filename & "]Sheet1'!B2" 'Sheet1 helyére azt a munkalapnevet kell írnod, ahol az adatok vannak a forrásfájlban.
Cells(2, xx).Formula = "='[" & Filename & "]Sheet1'!C8"
Cells(3, xx).Formula = "='[" & Filename & "]Sheet1'!B15"
' itt folytatod a kitöltést a fentiek szerint
xx = xx + 1 ' vesszük a következő oszlopba
Filename = Dir() 'a következő fájlt
Loop
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value ' a képleteket átváltjuk értékre
MsgBox "A másolásnak vége!", vbInformation
End SubMakrót az Alt+F11 után "feltűnő" VBA ablakba tudsz másolni. A menüből ki kell választanod az Insert - Module opciót. Ezután tudod a modulba bemásolni.
A forrásfájlokat utána kitörölheted - vagy az újakkal felülírhatod és ismételten lefuttatod a makrót.
Üdv.
[ Szerkesztve ]
-
Locsi
senior tag
Úgy néz ki probléma megoldva, a libreoffice szépen futtatja a makrókat.
-
Hoorus
őstag
Sziasztok!
Adott egy több ezer soros táblázat, mely egyik oszlopából azokat a sorokat kellene leszűrni, amelyek ismétlődnek. Pontosabban, csak azok a sorok maradjanak a táblázatban, amelyek többször elő fordulnak, az egyedi sorokat szeretném törölni belőle..
Van erre valamilyen megoldás?
Köszönöm
[ Szerkesztve ]
-
Delila_1
Topikgazda
válasz
Hoorus #26185 üzenetére
A DARABTELI függvény soronként kiírja, hányszor szerepel egy adat egy oszlopban.
Címsort feltételezve a B2 cella képlete =DARABTELI(A:A;A2)
Ezt végig másolod, majd autoszűrővel ezt az oszlopot szűröd 1-re, és törlöd a látható sorokat.Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Delila_1
Topikgazda
-
lokos19
csendes tag
Sziasztok!
kellene egy kis segítség Excelhez, meg kellene írni a programot úgy, hogy ne csak 6-os színre sárgára nézze a cellákat hanem 5 kék színre is és azt egy másik cellában összegezze. mondjuk a Cells(5, 12)
Sub szines()
Dim ter As String
Dim cell As Object
Dim össz As Variant
ter = "A14:V60"For Each cell In Range(ter)
If cell.Interior.ColorIndex = 6 Then össz = össz + cell.Value
Next
Cells(5, 5) = összEnd Sub
THX!
-
Delila_1
Topikgazda
válasz
lokos19 #26192 üzenetére
For Each cell In Range(ter)
If cell.Interior.ColorIndex = 6 Then Cells(5, 5) =Cells(5, 5) +cell.value 'sárga
If cell.Interior.ColorIndex = 5 Then Cells(5, 12) =Cells(5, 12) +cell.value 'kék
If cell.Interior.ColorIndex = 3 Then Cells(5, 15) =Cells(5, 15) +cell.value 'piros
NextProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
alevan
őstag
Szia. Köszi a segítséget. Lefutott, de sajnos semmi nem történt.
(#26183) Fferi50 Neked is köszönöm. Egy minimális módosítást kelett ezközölnöm (most, hogy már meg volt az alap, nem volt nehéz) és tökéletesen megy.
"Ezért lovagol a pokolba a konzumer IT piac. A hülye igények... . Azt sem tudod, hogy mit akarsz de az jöjjon havonta frissités formájában."
-
Fferi50
őstag
Szia!
Ebben a pár sorban van egy kis ellentmondás:
Workbooks.Open(Filename)
'Itt jön a másolgatás.
Range("B2").Select
Selection.Copy
Workbooks("Master.xlsx").Worksheets("Sheet1").Range(Cells(ActiveSheet.Usedrange.Rows.Count,1)).PasteSpecial xlPasteValues
A munkafüzet megnyitása után a megnyitott munkafüzet lesz aktív, eddig rendben.
A Select nélkül is lehet másolni: Range("B2").Copy
A bibi itt van szerintem:
Workbooks("Master.xlsx").Worksheets("Sheet1").Range(Cells(ActiveSheet.Usedrange.Rows.Count,1)).PasteSpecial xlPasteValues
mivel az ActiveSheet továbbra is az, ahonnan a másolást csinálod, azaz a megnyitott munkafüzet aktív munkalapja!
Helyette a Master fájl "Sheet1" munkalapjára kellene itt is hivatkozni. Ráadásul minden egyes file adatát ugyanabba a sorba (usedrange.rows.count) fogja beírni - azaz csak az utolsó fájl adata marad meg.
Ezen kívül a másolást lehet direktbe is csinálni:
Range("B2").Copy Destination:=Workbooks("Master.xlsx").Worksheets("Sheet1").Cells(Workbooks("Master.xlsx").Worksheets("Sheet1").UsedRange.Rows.Count + 1, 1)Természetesen a többi cella másolásánál már a UsedRange.Rows.Count kell.
Ha viszont csak az értéket szeretnéd átvenni, akkor működik ez is:
Workbooks("Master.xlsx").Worksheets("Sheet1").Cells(Workbooks("Master.xlsx").Worksheets("Sheet1").UsedRange.Rows.Count + 1, 1).Value=Range("B2").ValueÜdv.
[ Szerkesztve ]
-
Louro
őstag
válasz
Fferi50 #26183 üzenetére
Kreáltam magamnak egy feladatot és megnéztem ezt a megnyitásmentes megoldást és nekem az a baj, hogy ahhoz, hogy befrissüljön felugrik egy párbeszédablak, hogy tallózzam be a forrást. Az oké, hogy ha Esc-elem, akkor frissül, de nálam lehet a bibi?
Kódrészlet.
WB_Source_file = "D:\VB_Test\" & Year(Now - 30) & "\" & actual_month & "\" & code & ".xlsx"
Filename = Dir(WB_Source_file)
If Filename = "" Then
GoTo Nem_létezik_a_forrása
Else
For k = 1 To 3
Sheets("Összesített_eredmény").Cells(j, 3 + actual_month).Formula = _
"=HAHIBA('[" & Filename & "]TOTAL'!V29,""-"")"
Sheets("Kommunikáció").Cells(j, 3 + actual_month).Formula = _
"=HAHIBA('[" & Filename & "]TOTAL'!V10,""-"")"
Sheets("Mozgás").Cells(j, 3 + actual_month).Formula = _
"=HAHIBA('[" & Filename & "]TOTAL'!V18,""-"")"Rosszul hivatkozom be a másik munkafüzetet?
@26199: Köszi. Pont a hétvégén futottam bele ebbe a "másolás a célba" esetbe. Csak még nem gyakoroltam be, így ezért nem alkalmazom.
[ Szerkesztve ]
Mess with the best / Die like the rest
Új hozzászólás Aktív témák
- Politika
- NVIDIA GeForce RTX 4060 / 4070 S/Ti/TiS (AD104/103)
- M0ng00se: Northwood VS Prescott - Előszó, múltidézés
- Bivalyerős lett a Poco F6 és F6 Pro
- EAFC 24
- Metal topik
- S.T.A.L.K.E.R. Clear Sky
- Xbox Series X|S
- Kaposvár és környéke adok-veszek-beszélgetek
- HTPC (házimozi PC) topik
- További aktív témák...
- Eladó Steam kulcsok kedvező áron!
- Bontatlan - BATTLEFIELD 1 Collectors Edition - Játékszoftver nélkül
- Bitdefender Total Security 3év/3eszköz! - "Tökéletes védelem most kedvező áron..."
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! LEGOLCSÓBB! Automatikus 0-24
- PC JÁTÉKOK (OLCSÓ STEAM, EA , UPLAY KULCSOK ÉS SOKMINDEN MÁS IS 100% GARANCIA )