- erkxt: A Roidmi becsődölt – és senki nem szól egy szót sem?
- Magga: PLEX: multimédia az egész lakásban
- Luck Dragon: Asszociációs játék. :)
- droidic: Így beszélhetsz élő emberrel EA supportban
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- sziku69: Fűzzük össze a szavakat :)
- Elektromos rásegítésű kerékpárok
- sziku69: Szólánc.
- MasterDeeJay: Noname 1TB-os SATA SSD teszt
- hcl: MS Office365 Linuxon
-
LOGOUT
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
veterán
Nem őrizgetem a fájlokat, amikben segítséget adok. Arra gondolok, hogy megadom a választ, és kész. Ahányszor új kérésed van, újra létre kell hoznom a szükséges adatokat.
Valóban elnéztem a cserélendő részt, de még mindig nem világos, mit akarsz. Az a bizonyos "cég/sorszám/más" azonos az egyes fájlokban, vagy nem, a más mindig más, vagy mindenhol azonos? Ez nagyon nem mindegy. -
lappy
őstag
Na szerintem inkább neked kellene normálisan fogalmazni hogy mit szeretnél!
És remélem aki segíthetne a fórumon neked az egyik sem fog ezek után! Aki ismeri Delila1 azt tudja hogy egyáltalán nem olyan ahogy te leirtad és sokszor pont nekünk akik segítenek azoknak kell kihamozni hogy mit akar a másik. De a te esetedben nagyon nehéz. -
Delila_1
veterán
Már kértelek, hogy pontosan írd le, mit szeretnél. Először ezt írtad:
valami/izé -ből az "izé"-t kicserélni "hogyishíjják"-ra
ami sima szövegcsere, aztán kiderült, hogy egy sorszámot kell kicserélni egy 3 tagú szövegben, és ez növekedjen fájlonként.
Az előző makróba megjegyzésként beírtam, mire jó a kétféle útvonal. Ha nálad minden az elsőként megadott mappában van, akkor a másodikat elhagyhatod.Most csak a változó részt másolom ide.
Bővül a helyfoglalás.
Dim utvonal As String, sor As Long, usor As Long, sorszam As Integer
Dim kezd As Integer, veg As Integer
sorszam=1
és a With–End With rész
With Sheets(1)
.Range("B25") = .Range("B25") & " " & "Készítő neve"
kezd = InStr(.Range("K25"), "/") + 1
veg = InStr(kezd, .Range("K25"), "/")
.Range("K25").Replace What:=Mid(.Range("K25"), kezd, veg - kezd), Replacement:=sorszam, LookAt:=xlPart, SearchOrder:=xlByRows
sorszam = sorszam + 1
.Range("C25") = Date
.Range("D25") = .Range("D25") & " " & "Józsi"
End With
-
Delila_1
veterán
A makrót tedd egy üres füzetbe. Írd át az utvonal változó értékét két helyen értelem szerűen, és a txt fájl nevét.
Indításkor megnyitja a txt fájlt, ahol az A oszlopban (A1-től kezdve) szerepelnek az módosítandó fájlok nevei, kiterjesztéssel.
Egy ciklusban egyenként megnyitja a 900 fájlt, végrehajtja a módosításokat, és a cserét, amit most csak a B oszlopra írtam meg.Sub xx()
Dim utvonal As String, sor As Long, usor As Long
utvonal = "C:\Dokumentumok\___TEMP\" 'A címeket tartalmazó txt fájl útvonala
Workbooks.OpenText Filename:=utvonal & "megnyitando.txt" 'Cseréld ki a txt nevét
usor = Range("A" & Rows.Count).End(xlUp).Row
utvonal = "C:\Dokumentumok\___TEMP\Fájlok\" 'A módosítandó fájlok útvonala
For sor = 1 To usor
Workbooks.Open Filename:=utvonal & Cells(sor, 1)
With Sheets("Ellenőrzendő")
.Range("B25") = .Range("B25") & " " & "Készítő neve"
'Cserék a B oszlopban
Columns(2).Replace What:="izé", Replacement:="hogyishíjják", LookAt:= _
xlPart, SearchOrder:=xlByRows
.Range("C25") = Date
.Range("D25") = .Range("D25") & " " & "Józsi"
End With
ActiveWorkbook.Save
ActiveWorkbook.Close
Next
End Sub
-
Delila_1
veterán
Látod, ez már rendesebb. Először nem derült ki, miről van szó.
Sub xx()
Dim sMappa As String, s As String, wb As Workbook
sMappa = "C:\Dokumentumok\___TEMP\"
s = Dir(sMappa & "*.xls*")
Do While s <> ""
Set wb = Workbooks.Open(sMappa & s)
With wb.Sheets("Ellenőrzendő")
.Range("B25") = "Készítő neve"
.Range("C25") = Date
.Range("D25") = "Józsi"
End With
wb.Save
wb.Close False
s = Dir
Loop
End Sub
-
Pakliman
tag
Ha előre tudod, hogy melyik mappákban kell keresni, akkor kis bővítéssel működik.
Csak annyiszor kell a programkódot lemásolni a megfelelő mappanévvel, ahány mappában keresni akarsz.
Ezt csak néhány mappa esetén célszerű használni.
Természetesen a mappaneveket tömbbe is rakhatod, majd egy For..Next ciklussal végig mész rajtuk.
Így sokkal rövidebb (és elegánsabb) lesz a kód.Sub xx()
Dim aMappa
Dim sMappa As String
Dim s As String
Dim wb As Workbook
Dim i As Long
aMappa = Array( _
"C:\Dokumentumok\___TEMP\", _
"c:\Dokumentumok\Run\", _
"c:\Dokumentumok\_ VEGYES\_Downloads\" _
)
For i = LBound(aMappa) To UBound(aMappa)
sMappa = aMappa(i)
s = Dir(sMappa & "*.xls*")
Do While s <> ""
Set wb = Workbooks.Open(sMappa & s)
If IsEmpty(wb.Worksheets("Ellenőrzendő").Range("B25")) Then
wb.Worksheets("Ellenőrzendő").Range("B25") = "Készítő neve"
wb.Save
End If
wb.Close
s = Dir
Loop
Next i
End SubVáltozó mappastruktúra esetén már előkerül a rekurzív könyvtárkezelés.
Az már egy kicsit bonyolultabb dolog. -
Pakliman
tag
Sub xx()
Dim sMappa As String
Dim s As String
Dim wb As Workbook
sMappa = "C:\Dokumentumok\___TEMP\"
s = Dir(sMappa & "*.xls*")
Do While s <> ""
Set wb = Workbooks.Open(sMappa & s)
If IsEmpty(wb.Worksheets("Ellenőrzendő").Range("B25")) Then
wb.Worksheets("Ellenőrzendő").Range("B25") = "Készítő neve"
wb.Save
End If
wb.Close
s = Dir
Loop
End Sub -
[w]
őstag
ok, rájöttem mi volt a gond, de most egy másik adódott...
a B-C oszlop dátumai ugyanis úgy keletkeznek, hogy máshonnan a 2017.01.01-2017.01.31 formában beírt időszakot BAL és JOBB függvénnyel bontom kezdete és végére, de így nem dátumként érzékeli
ha a bontott értékek szerkesztésekor az érték végén nyomok egy del-t és utána enter, akkor azonnal dátumformátumra állítja és a MIN-MAX képletek is jól lefutnakcsakhogy 6000 soron nem tudom ezt az értékkorrekciót végigcsinálni kézzel
-
Delila_1
veterán
Bemásoltam a neveket a H oszlopba, és ott az Adatok | Adateszközök | Ismétlődések eltávolítása funkcióval megszüntettem a többszörözést.
Az I2 cella képlete:=MIN(HA($A$2:$A$30=H2;$B$2:$B$30))
A J2-é pedig:=MAX(HA($A$2:$A$30=H2;$C$2:$C$30))
Mindkettő tömbfüggvény, Shift + Ctrl + Enter-rel kell bevinned. A képletek lefelé másolhatók.Természetesen a 30-at mindkét képletben írd át annyira, amennyire szükséges.
Új hozzászólás Aktív témák
- Milyen alaplapot vegyek?
- Okos Otthon / Smart Home
- Megjelent a Poco F7, eurós ára is van már
- AMD Navi Radeon™ RX 6xxx sorozat
- Háztartási gépek
- HiFi műszaki szemmel - sztereó hangrendszerek
- Vezetékes FEJhallgatók
- erkxt: A Roidmi becsődölt – és senki nem szól egy szót sem?
- Mobil flották
- Sütés, főzés és konyhai praktikák
- További aktív témák...
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! Automatikus 0-24
- Microsoft licencek KIVÉTELES ÁRON AZONNAL - UTALÁSSAL IS AUTOMATIKUS KÉZBESÍTÉS - Windows és Office
- Windows 10/11 Home/Pro , Office 2024 kulcsok
- Bontatlan - BATTLEFIELD 1 Collectors Edition - Játékszoftver nélkül
- LG 65B4 - 65" OLED - 4K 120Hz 1ms - NVIDIA G-Sync - FreeSync Premium - HDMI 2.1 - PS5 és Xbox Ready
- BenQ PD-3200-U Monitor - Designer 4K 32"
- REFURBISHED és ÚJ - HP USB-C Dock G5 docking station (5TW10AA) - 3x4K felbontás, 120Hz képfrissítés
- Telefon felvásárlás!! Samsung Galaxy A14/Samsung Galaxy A34/Samsung Galaxy A54
- BESZÁMÍTÁS! ASRock B250 i5 6600 16GB DDR4 256 SSD 500GB HDD GTX 1050 2GB Zalman Z1 Njoy 550W
Állásajánlatok
Cég: PC Trade Systems Kft.
Város: Szeged
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest