- Android alkalmazások - szoftver kibeszélő topik
- Honor Magic6 Pro - kör közepén számok
- Redmi Note 13 Pro+ - a fejlődés íve
- iPhone topik
- Elcsípte a Huawei kameratelefonja az első helyet
- Samsung Galaxy S24 Ultra - ha működik, ne változtass!
- Fotók, videók mobillal
- Drágább lett a Pixel 8a
- Képeken a Honor 200 Pro
- Motorola Moto G54 5G Power Edition - nem merül le
Hirdetés
-
2024 - Íme a 21. héten megjelenő játékok listája
gp Az elkövetkező napokban érkezik végre a Senua's Saga: Hellblade II és az xDefiant.
-
Hardverek pünkösdre
ph E-book olvasók, komponensek és perifériák kerültek hétvégi összeállításunkba.
-
Retro Kocka Kuckó 2024
lo Megint eltelt egy esztendő, ezért mögyünk retrokockulni Vásárhelyre! Gyere velünk gyereknapon!
-
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
-
Ingenium
újonc
válasz Delila_1 #22156 üzenetére
Nos ide eljutottam, be is irtam, jo is lett - reszben
Ha az A1=1 es B1=1 vagy ha 2 vagy 3 vagy mindegy mennyi de egyforma az ertekuk, akkor gyonyoruen formaz, mukodik es ha nincs ertekuk vagyis uresek, akkor szep feher, de
Amint az ertekuk 0 es 0, akkor nem formaz, tudom ,h az ures az 0 de itt szeretnem becsapni az excelt ha fizikalisan szerepel a cellakban mindket hely4n a 0, akkor az olyan legyen neki mint az 1-1
Tudom h nem tudok magyarazni, bocsanat es koszonom,h foglalkoztok a problemammal es meg jopar szamomra nagyon nehez dolog jon majd de ezt elobb meg kell csinalnom.
-
cadgers
aktív tag
Sziasztok, kis segítséget szeretnék kérni!
2 legördülő listát szeretnék csinálni, mindkét listában kizárólag számok vannak
Az egyik listában 1-től 4-ig lehet választani, a másikban 1-től 8-ig.
Azt szeretném megoldani hogy ha az első listában 1-es szerepel, akkor a másodikban csak 1 és 2 lehessen a választható szám, ugyanígy a többinél is, pl 2-höz 3-4, 3-hoz 5-6, és végül 4-eshez 7-8.Megvan a 2 oszlopom a számokkal, meg a dropdown listák is, csak ez a kritériumos dolog nem tudom hogy van. Valaki segítsen plz
-
Delila_1
Topikgazda
válasz cadgers #22158 üzenetére
A1-ben van az első érvényesítés, ahol az 1-4 számok közül választhatsz.
A másik érvényesítéshez a G1:G8 tartományba bevittem a számokat 1-től 8-ig. Az érvényesítésben itt is lista a megengedett érték, mint az elsőnél, a forrás pedig
=HA(A1=1;$G$1:$G$2;HA(A1=2;$G$3:$G$4;HA(A1=3;$G$5:$G$6;$G$7:$G$8)))
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
atillaahun
veterán
Sziasztok,
van arra valami (egyszerű) függvény, hogy ékezetes városokat szűrjek ki egy listából (oszlopból)? -
lappy
őstag
-
slashing
senior tag
Van valakinek arra kész Makrója hogy egy adott könyvtáron belül végig fut egy akármilyen kód(pl. törölje ki az A,B,C oszlopot) az összes fájlon és automatikusan rá is ment azokra a fájlokra?
-
slashing
senior tag
válasz slashing #22165 üzenetére
tárgytalan google segített:
Sub ProcessFiles()
Dim Filename, Pathname As String
Dim wb As WorkbookPathname = ActiveWorkbook.Path & "\Files\"
Filename = Dir(Pathname & "*.xls")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
DoWork wb
wb.Close SaveChanges:=True
Filename = Dir()
Loop
End SubSub DoWork(wb As Workbook)
With wb
'Do your work here
.Worksheets(1).Range("A1").Value = "Hello World!"
End With
End Sub -
tgumis
tag
Sziasztok!
Kérdésem a következő. Egy excel táblát használok körlevél adatfájljának. Kérdés a következő hogy tudom azt megoldani hogy a world doksiban ne így jelenjen meg a dátum:
Fizetési határidő 7/25/2014
hanem úgy ahogy az excelben szerepel:
fizetési határidő 2014.07.25
Excelben a formátum dátumra van állítva ráadásul számolás eredménye. -
slashing
senior tag
Szép lassan összelopkodom innen onnan ami kell de most kicsit megakadtam.
Ez a makró jelenleg azt csinálj hogy az A3:A1000 tartományban megkeresni a nem üres cellákat, kijelöli azokat majd átmásolja a Mega lapra transzponálva.
Na most én azt szeretném hogy ne a mega lapra másolja hanem a mega.xlsx-be és oda is úgy kellene hogy mindig az első üres sorba egymás alá. Ez azért fontos mert a két hozzászólással feljebb lévő minden munkafüzeten lefutó makróba kell majd ezt bele applikálnom(a hello world helyére). Szóval a végén a Mega.xlsb-ben elvileg annyi sorban lesznek adatok ahány munkafüzet van az adott könyvtárban ahol le fog futni a makró.Sub it()
Dim cell As Range
Dim selectRange As RangeFor Each cell In ActiveSheet.Range("A3:a1000")
If (cell.Value <> "") Then
If selectRange Is Nothing Then
Set selectRange = cell
Else
Set selectRange = Union(cell, selectRange)
End If
End If
Next cellselectRange.Select
Selection.Copy
Sheets("mega").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub[ Szerkesztve ]
-
slashing
senior tag
válasz slashing #22168 üzenetére
de istenigazából az is tökéletes megoldás nekem ha a mega munkalapra kerül egymás alá.
És akkor a munkafüzeten1-en lenne egy makró indítás gomb a mega lapon meg ott lenne minden fájlból az adat. Ez még jobb is mint a ha külön fájlba menne!faszán össze flood-oltam a fórumot
[ Szerkesztve ]
-
-
Delila_1
Topikgazda
válasz slashing #22169 üzenetére
[Sub it()
Dim cell As Range, usor As Long
Dim selectRange As Range
usor = Sheets("Munka1").Range("A" & Rows.Count).End(xlUp).Row
For Each cell In ActiveSheet.Range("A3:A" & usor)
If (cell.Value <> "") Then
If selectRange Is Nothing Then
Set selectRange = cell
Else
Set selectRange = Union(cell, selectRange)
End If
End If
Next cell
usor = Sheets("mega").Range("A" & Rows.Count).End(xlUp).Row + 1
selectRange.Copy
Sheets("mega").Range("A" & usor).PasteSpecial Paste:=xlPasteAll, Transpose:=True
End Sub[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
slashing
senior tag
válasz Delila_1 #22171 üzenetére
Uhh ez tök jól működik és naivan azt hittem az összefűzés a másik makróval már gyerek játék lesz de valamiért hibaüzenetet dob ki miután megnyitotta az első fájlt(Object variable or With block variable not set). Szerintem az zavar be neki hogy nem tudja hol dolgozzon vagy valami hasonló most így néz ki kb. csak összemásoltam a kettőt. A kiemelt résznél van gondolom a hiba hogy melyik workbook-al mit szeretnék csinálni de nem jövök rá mit kéne átírnom hozzá...
Sub ProcessFiles()
Dim Filename, Pathname As String
Dim wb As WorkbookPathname = ActiveWorkbook.Path & "\Files\"
Filename = Dir(Pathname & "*.xls")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
it wb
wb.Close SaveChanges:=Yes
Filename = Dir()
Loop
End SubSub it(wb As Workbook)
With wb
'Do your work here
Dim cell As Range, usor As Long
Dim selectRange As RangeFor Each cell In ActiveSheet.Range("A3:A1000")
If (cell.Value <> "") Then
If selectRange Is Nothing Then
Set selectRange = cell
Else
Set selectRange = Union(cell, selectRange)
End If
End If
Next cellusor = Sheets("mega").Range("A" & Rows.Count).End(xlUp).Row + 1
selectRange.Copy
Sheets("mega").Range("A" & usor).PasteSpecial Paste:=xlPasteAll, Transpose:=True
End With
End SubÚgy kéne összefűzni a két makrót hogy van egy összesítés.xls amiben csak egy makróindító gomb van illetve a mega munkalap. Ha elindítom a gombbal a makrót akkor a files könyvtárban lévő fájlokból kimásolgatja ide az a3:a1000 nem üres celláit transzponálva egymás alá.
[ Szerkesztve ]
-
Delila_1
Topikgazda
válasz slashing #22169 üzenetére
Az előbbi makró csak a megnyitott fájl adatainak a másolását oldotta meg. A mostaniban a fájlok megnyitása, és zárása is szerepel.
A Pathname változóban írd át az útvonalat. Nem érdemes az összefűzendő fájlokat és azt, amelyikben összefűzöd, azonos mappában tartani.
Sub ProcessFiles()
Dim Filename, Pathname As String, WBN As String
Dim wb As Workbook
WBN = ActiveWorkbook.Name
Pathname = "F:\Eadat\valami\"
Filename = Dir(Pathname & "*.xls")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
DoWork wb, WBN
wb.Close SaveChanges:=True
Filename = Dir()
Loop
End SubSub DoWork(wb As Workbook, WBN)
Dim usor As Long, cell As Range, selectRange As Range
With wb
usor = .Sheets("Munka1").Range("A" & Rows.Count).End(xlUp).Row
For Each cell In .Sheets(1).Range("A3:A" & usor)
If (cell.Value <> "") Then
If selectRange Is Nothing Then
Set selectRange = cell
Else
Set selectRange = Union(cell, selectRange)
End If
End If
Next cell
usor = Workbooks(WBN).Sheets("mega").Range("A" & Rows.Count).End(xlUp).Row + 1
selectRange.Copy
Workbooks(WBN).Sheets("mega").Range("A" & usor).PasteSpecial Paste:=xlPasteAll, Transpose:=True
End With
End SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
slashing
senior tag
Kiegészítettem két sorral hát ha kell másnak is az első ami kikapcsolja vagy legalábbis nem mutatja a megnyitás bezárást(Application.ScreenUpdating = False) így gyorsul a program kb. 25-50%-ot illetve ha sok adat kerül a vágólapra a kilépésnél mindig feldobott egy ablakot hogy megtartom-e vagy sem(Application.CutCopyMode = False).
A ScreenUpdating-et vissza kell amúgy kapcsoltatni a makró végén vagy nem szükséges?
Sub teszt_61201121()
Dim Filename, Pathname As String, WBN As String
Dim wb As Workbook
Application.ScreenUpdating = False
WBN = ActiveWorkbook.Name
Pathname = "c:\teszt\6120-1121\"
Filename = Dir(Pathname & "*.xls")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
DoWork wb, WBN
Application.CutCopyMode = False
wb.Close SaveChanges:=True
Filename = Dir()
Loop
End Sub
Sub DoWork(wb As Workbook, WBN)
Dim usor As Long, cell As Range, selectRange As Range
With wb
usor = .Sheets("Munka1").Range("A" & Rows.Count).End(xlUp).Row
For Each cell In .Sheets(1).Range("C3:C" & usor)
If (cell.Value <> "") Then
If selectRange Is Nothing Then
Set selectRange = cell
Else
Set selectRange = Union(cell, selectRange)
End If
End If
Next cell
usor = Workbooks(WBN).Sheets("6120-1121 PCB OLDAL").Range("A" & Rows.Count).End(xlUp).Row + 1
selectRange.Copy
Workbooks(WBN).Sheets("6120-1121 PCB OLDAL").Range("A" & usor).PasteSpecial Paste:=xlPasteAll, Transpose:=True
End With
End Sub[ Szerkesztve ]
-
Delila_1
Topikgazda
-
lappy
őstag
válasz tgumis #22180 üzenetére
Nagy M betűvel írja, hogy megkülönböztesse a perctől (m).
M: Ez a formátumelem számjeggyel jeleníti meg a hónapokat, egyszámjegyű hónapok esetén kezdő 0 (nulla) nélkül. Július esetében például: 7.
MM: Ez a formátumelem számjeggyel jeleníti meg a hónapokat, egyszámjegyű hónapok esetén kezdő 0-val. Július esetében például: 07.
MMM: Ez a formátumelem rövidítésként jeleníti meg a hónapneveket, július esetében például: júl.
MMMM: Ez a formátumelem teljes névvel jeleníti meg a hónapokat.Bámulatos hol tart már a tudomány!
-
slashing
senior tag
A fenti Makróban azt meg lehet oldani hogy a fájl elérési útjának a vége, jelen esetben /6120-1122/ illetve a lapnak a neve jelen esetben 6120-1121 PCB OLDAL egy listából változzon, lenne egy lista mellette egy indító gomb vagy valami hasonló? mert ezt a kettőt könnyedén egy nevezőre tudom hozni és ha megoldható akkor nem kéne vagy 100 variációban lemásolni a module-t ami egy esetleges módosítás után kellemetlen lenne mindegyiken végigzongorázni nem beszélve arról hogy mekkora hibalehetőséggel járna.
[ Szerkesztve ]
-
Delila_1
Topikgazda
válasz slashing #22183 üzenetére
Legegyszerűbb, ha minden füzetben a másolandó oldalt az első helyre mozgatod. Ekkor a DoWork makróban a
usor = .Sheets("Munka1").Range("A" & Rows.Count).End(xlUp).Row
sor helyett
usor = .Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
kerül, a
Workbooks(WBN).Sheets("6120-1121 PCB OLDAL").Range("A" & usor).PasteSpecial Paste:=xlPasteAll, Transpose:=True
helyett pedig
Workbooks(WBN).Sheets(1).Range("A" & usor).PasteSpecial Paste:=xlPasteAll, Transpose:=True
Az összegző füzetben is első legyen a lap, ahova bemásolod a többi füzetből az adatokat.
[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
slashing
senior tag
válasz Delila_1 #22184 üzenetére
Egy fájlban lesz az egész sok-sok lap-al kb. 50<>100 nehézkes lenne a lapok mozgatása nah meg a userek betanítása erre akiknek sokszor gondot okoz az is hogy egy könyvtárat két kattintással nyitunk meg áhhhh ugyhogy vagy maradok a másolás átírásnál vagy ha egyszerűen megoldható akkor listaválasztó vagy űrlapos megoldás vagy bármi
Az első munkalap amolyan termék választóként funkcionál ahol most gomokkal indítható az egyes termékek moduljai amik ugye csak a fájl elérési útjában és másolandó adatok lapjának nevében különböznek.
De ha bonyolult megoldani akkor lemásolom annyi példányban amennyiben kelleni fog annyira nem tervezem módosítgatni benne a dolgokat.
-
Delila_1
Topikgazda
válasz slashing #22185 üzenetére
Akkor ugorj neki újra.
1 db fájlba, különböző lapokra akarod bemásolni több füzet lapjainak a tartalmát?
A gyűjtő füzet lapjait úgy nevezted el, hogy a név egyúttal a mappa neve, ahonnan be akarod gyűjteni az adatokat?Ahonnan másolsz, azok a füzetek hány lapot tartalmaznak?
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
-
Delila_1
Topikgazda
válasz slashing #22192 üzenetére
Próba nélkül az első makró (nálam most éppen bedöglött az Excel).
Sub ProcessFiles()
Dim Filename, Pathname As String, WBN As String, WS As String
Dim wb As Workbook
Application.ScreenUpdating = False
WBN = ActiveWorkbook.Name
WS = ActiveSheet.Name
Pathname = "C:\teszt\" & WS & "\"
Filename = Dir(Pathname & "*.xlsx")
Do While Filename <> ""
Set wb = Workbooks.Open(Pathname & Filename)
DoWork wb, WBN, WS
wb.Close SaveChanges:=True
Filename = Dir()
Loop
Application.ScreenUpdating = True
End SubBármelyik oldalról indítva elméletileg a saját könyvtárából hívja be, és másolja a füzetek adatait.
[ Szerkesztve ]
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
válasz slashing #22192 üzenetére
A DoWork makró End With fölötti sora legyen
Workbooks(WBN).Sheets(WS).Range("A" & usor).PasteSpecial Paste:=xlPasteAll, Transpose:=True
Szerk.:
Inkább leírom a 2. makrót is.
Sub DoWork(wb As Workbook, WBN, WS)
Dim usor As Long, cell As Range, selectRange As Range
With wb
usor = .Sheets("Munka1").Range("A" & Rows.Count).End(xlUp).Row
For Each cell In .Sheets(1).Range("A3:A" & usor)
If (cell.Value <> "") Then
If selectRange Is Nothing Then
Set selectRange = cell
Else
Set selectRange = Union(cell, selectRange)
End If
End If
Next cell
usor = Workbooks(WBN).Sheets(WS).Range("A" & Rows.Count).End(xlUp).Row + 1
selectRange.Copy
Workbooks(WBN).Sheets(WS).Range("A" & usor).PasteSpecial Paste:=xlPasteAll, Transpose:=True
End With
End Sub[ Szerkesztve ]
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
slashing
senior tag
-
Delila_1
Topikgazda
válasz slashing #22195 üzenetére
Szívesen.
Igen, a WS változó az aktív lap nevét tárolja, és ezt adja át a Pathname változónak is.
Kiteszed a gombot az első 6120-... lapra, hozzárendeled a ProcessFiles makrót. A gombon a szöveg olyasmi lehet, hogy Adatok bemásolása. Ezt a gombot másolod az összes többi lapra. Bárhonnan indítod, mindig a saját könyvtárából hívja be a fájlokat.Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
-
slashing
senior tag
válasz Delila_1 #22197 üzenetére
Gyártásfüggő, egyszerre csak egyet, ha nincs elmaradás ami a jelenlegi rendszert nézve mindig van mivel most az ember van a számítógépért elv érvényesül és nem fordítva, szokás szerint senki nem gondolkozott mielőtt kitalált valamit.
Kapaszkodj mert így működik jelenleg:
Elindul a gyártás az egyik termékkel, lemér az ellenőr mondjuk 10 darabot egyik oldalt vagy másik oldalt. Ebből kap 10 db PDF-et! A 10 darab PDF-et jelenleg mivel nincs converter kézzel megnyitogatja majd bemásolja egy excel táblába és elmenti ezt 10-szer, nem ám csv pdf az kell. Az így kapott 10 excel táblázaton lefuttat egy arra a termékre vonatkozó makrót(makró rögzítés rulez) ami kitörli a felesleges adatokat és csak a szükséges marad benne. Majd ezeket átmásolja még kézzel egy copy of all-ba(nah ezt a feladatot oldottuk most meg úgy hogy csak az adott oszlop adatait össze ollózza) ahonnan szintén kézzel átmásolja az adatokat az adott termék adott méretre vonatkozó excel táblájába. Ez azért k**** jó mert van olyan hogy 100 méret van szóval 100 különböző fájlba kell szétdobálni a copy of all-ból az egyes méreteket. Ezek után már csak egy sima cellahivatkozás kell majd mindegyikbe bevinni hogy ebből a táblából frissítse eddig ezt azért nem lehetett megcsinálni mert egy munkalapra volt ömlesztve minden terméknek az értékei. Ha akartam volna sem találok ki ilyen bonyolult és időigényes dolgot. Így is baromi sok munka lesz feltölteni a cellahivatkozás képletekkel a meglévő sacc/kb 3000 táblázatot.
Ez a leggyorsabb embernek is több óra műszakonként és akkor még nem beszéltünk olyanról hogy termékváltás van vagy csak szimplán méretellenőrzés
[ Szerkesztve ]
Új hozzászólás Aktív témák
- Milyen légkondit a lakásba?
- Synology NAS
- Pécs és környéke adok-veszek-beszélgetek
- Házimozi belépő szinten
- Horgász topik
- Kerékpárosok, bringások ide!
- bb0t: Gyilkos szénhidrátok, avagy hogyan fogytam önsanyargatás nélkül 16 kg-ot
- Vigneau interaktív lokálblogja
- Építő/felújító topik
- Távol-keleti webshopok OFF topikja (játékok, kuponok, stb.)
- További aktív témák...
Állásajánlatok
Cég: Ozeki Kft.
Város: Debrecen
Cég: Alpha Laptopszerviz Kft.
Város: Pécs