- Telekom otthoni szolgáltatások (TV, internet, telefon)
- Microsoft Excel topic
- Crypto Trade
- Súlyos adatvédelmi botrányba kerülhet a ChatGPT az EU-ban
- MinDig TV
- Rendszergazda topic
- Mindenki AI-t akar, már 2025-re is eladták a HBM chipeket
- Proxmox VE
- Kapnak egy rakás reklámot a Roblox játékosai
- ArchiCAD és Artlantis topik
-
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 detroitrw #16898 üzenetére
Szövegből oszlopok, határoló jel a + jel. Ez a példád szerint az A1-be írt adatot szétszedi az A1:G1 tartományba.
Könnyítésként soronként egy függvény megszámlálja, hogy hány féle adat van a sorodban.
=SZORZATÖSSZEG((A1:G1<>"")/DARABTELI(A1:G1;A1:G1))Utána már a darabteli függvénnyel megszámolhatod az egyes adatokat soronként.
J1 -be =DARABTELI($A$1:$G$1;1603)
K1-be =DARABTELI($A$1:$G$1;640)
L1-be =DARABTELI($A$1:$G$1;388)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 atillaahun #16899 üzenetére
Előbb pucold ki a szemét karaktereket.
Az előbbi makró végére:Columns("A:A").Select
Selection.Replace What:=")", Replacement:="", LookAt:=xlPart
Selection.Replace What:=":", Replacement:="", LookAt:=xlPart
Selection.Replace What:=">", Replacement:="", LookAt:=xlPartstb. Ez sok szemetet eléget.
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
válasz Delila_1 #16900 üzenetére
Ezt így hirtelen fogalmam sincs hogy kell, de már végülis kivágtam a címeket <-től >-ig, amibe nem volt, azt meg hahiba-val visszaadtam. Így most nagyjából 95%+ -os, a maradékot meg asszem kiírkálom kézzel.(#16902) Delila_1
Oké. Mindjárt meglátom akkor így mi marad belőle.[ Szerkesztve ]
-
atillaahun
veterán
Nah jó lesz ez, még a .hu után lévőket levagdosom róla közép-pel, ami 1-2-nek az elejére ráragadt azt meg kitörlöm kézzel.
Ismételten köszönöm a hathatós segítséget. -
Delila_1
Topikgazda
válasz atillaahun #16904 üzenetére
Lehet, hogy tényleg gyorsabb szövegfüggvényekkel.
B1: =KÖZÉP(A1;SZÖVEG.KERES("<";A1)+1;256)
C1: =BAL(B1;SZÖVEG.KERES(".hu";B1)+2)Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Mutt
aktív tag
válasz atillaahun #16876 üzenetére
Hello,
Olyan függvény van, ami megszámolja, hogy bizonyos karakter/kifejezés hányszor szerepel egy cellában?
Erre a megoldás, hogy megszámolod mennyivel lett rövidebb a szöveged, ha törőlted belőle a kivánt karakter(eke)t.
A képlet (A1-ben az eredeti szöveg, B1-ben a keresendő karakter(ek):
=(HOSSZ(A1)-HOSSZ(HELYETTE(A1;B1;"")))/HOSSZ(B1)üdv.
A tanácsaimat ingyen adom. Ha nem tetszik, akkor kérlek ne kritizáld! / https://github.com/viszi/codes/tree/master/Excel
-
Mutt
aktív tag
válasz artiny #16865 üzenetére
Hello,
most egy olyan függvényt keresek ami megtalalja abszolut ertekben a 2 legnagyobb erteket
Excelbarát megoldása rendben műkődik, amíg a számok között nincs ismétlődés (esetedben is csak akkor van gond, ha a maximum pl. 9 többször szerepel).
Ha ez nem okoz gondot, akkor NAGY(tartomány;2) kell neked, ha CSE függvényként viszed fel akkor még a segédoszlopra, ahova az abszolút értéket teszed sincs szükség:
{=NAGY(ABS(tartomány);2)}
Ha viszont tényleg a második legnagyobb szám kell, akkor kell egy segédoszlop vagy egy UDF.
A segédoszlopba (pl. B1) ez a képlet kell (adatok A1.A8-ban vannak):
=(ABS(A1)<>MAX(ABS(MAX($A$1:$A$8));ABS(MIN($A$1:$A$8))))*ABS(A1)A segédoszlop maximuma lesz a 2. legnagyobb érték, amit keresel.
üdv.
A tanácsaimat ingyen adom. Ha nem tetszik, akkor kérlek ne kritizáld! / https://github.com/viszi/codes/tree/master/Excel
-
Mutt
aktív tag
válasz detroitrw #16893 üzenetére
Hello,
adott:
A1=1603+1603+640+640+640+388+388 -> pl. B1=2db - 1603Gondolom a számok is változnak (nem mindig csak 1603, 640 és 388 ismétlődik), ezért csak függvényekkel megoldani körülményes, javaslatom a lenti makró (mindig csak a kijelölt cellát vizsgálja):
Sub Szetszed()
Dim arraySplit
Const strDelimiter As String * 1 = "+" 'tagolás jele
Dim arrayResult() 'itt lesznek a darabszámok és a számok/karakterek
Dim c As Long, i As Long
Dim blnHit As Boolean 'logikai jelző ha már létezik a vizsgált szám
arraySplit = Split(ActiveCell.Value, strDelimiter)
If IsArray(arraySplit) And UBound(arraySplit) > 0 Then
ReDim arrayResult(1 To 2, 1) 'találat létrehozása
arrayResult(1, 1) = 1 '1 db
arrayResult(2, 1) = arraySplit(0) 'első érték megjegyzése
'további számokon végigfut
For c = 1 To UBound(arraySplit)
blnHit = False
i = 1
Do
'ha már van ilyen szám, akkor eggyel növeljük a számlálót
If arraySplit(c) = arrayResult(2, i) Then
arrayResult(1, i) = arrayResult(1, i) + 1
blnHit = True
End If
i = i + 1
Loop Until blnHit Or i > UBound(arrayResult, 2)
'ha még nincs ilyen akkor megjegyezzük a számot
If Not blnHit Then
ReDim Preserve arrayResult(1 To 2, UBound(arrayResult, 2) + 1)
arrayResult(1, UBound(arrayResult, 2)) = 1
arrayResult(2, UBound(arrayResult, 2)) = arraySplit(c)
End If
Next c
Application.ScreenUpdating = False
For i = 1 To UBound(arrayResult, 2)
Cells(ActiveCell.Row, ActiveCell.Column + i) = arrayResult(1, i) & " db - " & arrayResult(2, i)
Next i
Application.ScreenUpdating = True
End If
End Subüdv.
A tanácsaimat ingyen adom. Ha nem tetszik, akkor kérlek ne kritizáld! / https://github.com/viszi/codes/tree/master/Excel
-
madd dogg
senior tag
Hi.
Van AP visszajelző oszlopom, amiben függvények segítségével 4 betű szerepelhet, x, y, z, és w. Ezen négy betűhöz hozzárendeltem négy színt, adott betű esetén adott színnel töltődik ki a cella. Én azt szeretném, ha a betű maga nem látszana. Van rá mód, hogy egy betűt színtelenné tegyek?
Próbálkoztam létrehozni AQ oszlopot, ami másolja AP kitöltőszínét, de ehhez sem képletet, sem feltételes formázást nem ismerek. Tud valaki segíteni?
-
G.A.
aktív tag
Üdv!
Egy idegesítő problémába ütköztem.
Egy táblában a vesszős számokat pl 5,5 4,5 ... stb. kellene átalakítanom 5.5 ill. 4.5 re.
A gondom csak az, hogy az a ........... automatikus dátum ........... -ág mindig elrontja nekem. A csere funkció sem jó mivel akkor is 40000-res értékeket kapok, szóval először váltja dátumra, aztán normálisan próbálja meg kiírni. A cellát már próbáltam szövegként is formázni, de ekkor sem megy.
A net(google) meg szintén nem segített.... Főleg így hajnali fél 3kor.... (Aludni kéne, de az sem megy.)
GA
-
Mutt
aktív tag
válasz detroitrw #16910 üzenetére
Hello,
...ez a makró A1-A2000 -ig végigfusson?
Az elején és a végén kell egy kicsit módosítani:
Dim blnHit As Boolean 'logikai jelző ha már létezik a vizsgált szám
Dim cell As Range
For Each cell In Range("A1:A2000")
arraySplit = Split(cell, strDelimiter)
...<itt marad az eredeti> ...
For i = 1 To UBound(arrayResult, 2)
Cells(cell.Row, cell.Column + i) = arrayResult(1, i) & " db - " & arrayResult(2, i)
Next i
Application.ScreenUpdating = True
End If
Next
End SubA tanácsaimat ingyen adom. Ha nem tetszik, akkor kérlek ne kritizáld! / https://github.com/viszi/codes/tree/master/Excel
-
detroitrw
addikt
Szia!
kipróbáltam, de hibát lök a futtatáskor
egy ilyennel oldottam meg:
A = ActiveCell.Row
B = ActiveCell.Column
ActiveSheet.Cells(A + 1, B + 0).Selectmivel ez csak 1 ciklus így adtam neki egy ciklus mennyiséget:
Private Sub xxxxx
For x = 1 To 1000
......
Next x
End Subnem olyan elegáns de megoldja a gondom
Köszi
[ Szerkesztve ]
-
w.miki
veterán
válasz detroitrw #16915 üzenetére
Hali!
Excel(2003)ben hogyan lehet megcsinálni, hogy egy cellában a sor végéig pontok legyenek egy oszlopban?
Egy szótár.xls-ról van szó, most így néz ki:
A----------------------B-----------------------------C--------------D
accompaniment kísérő / kiegészítő braise dinsztel hústilyenre szeretném:
A----------------------B-----------------------------C--------------D
accompaniment..kísérő / kiegészítő braise.......dinsztel hústOlcsó kütyük: http://tiny.cc/fbkutyu
-
MZsoltee
veterán
Sziasztok!
Régen 3-4 éve egész jól tudtam használni az excel. Szükségem lenne valamire, amivel felfrissíthetem a tudásomat. Nem tud valaki valami kis tanfolyam tutorial cuccost kezdőtől haladóig?
A tökéletes nő süketnéma, nimfomániás, és az apjának kocsmája van.
-
Bocimaster
csendes tag
Sziasztok!
Egy kis macro-t keresek.
Lapokat szeretnék összefűzni az első lapra minden lapon 16 sort (4.-től)
pl:95 lapom van, a macro rögzitővel egy szintig eljutottam de a folyamatosság hiányzik......előre is köszi
Az ösztön mindig többet ér az észnél.
-
akyyy
senior tag
van egy oszlopom ahol igy néz ki kb a tábla:
XYZ
valami
[üres]
[üres]
[üres]
XZZ
valami
[üres]
[üres]
[üres]tehát az A1-ben van egy XYZ szöveg, majd az A6-ban, majd az A11-ben, és igy tovább
A B oszlopban egymás alá szeretném ezeket beirni hivatkozással, tehát igy:
=A1
=A6
=A11a gondaz, hgoy ha ezt lehúzom kitöltés szerüen, akkor az 11-es után szerinte ez jön: A4, majd A9, az A16-os helyett.... remélem érthető
-
zenefan
aktív tag
Nem volt időm minden hozzászólást végignézni, de hogy lehet EXCELben olyan diagramos kimutatást készíteni (tehát y tengely mutatja a DARABSZÁMOT, x tengely a TELEPÜLÉSEKET) hogy egy oszlopban lévő település nevekből kirajzolja / kiszámolja hogy hányszor szerepel benne pl. Budapest, Pécs, Miskolc... stb.
Az külön öröm lenne ha csak azokat rajzolná ki, amelyek pl. 2-nél többször szerepelnek az oszlopban.Köszönöm a figyelmet!
[ Szerkesztve ]
2021-as Black Friday akciók és konzol árak gyűjtése: https://bit.ly/bfd_21
-
Delila_1
Topikgazda
válasz zenefan #16920 üzenetére
Leírni hosszabb lesz, mint végrehajtani...
Vegyük, hogy az A oszlopban vannak a városaid, A1 a cím: Városok. B1-be beírsz egy címet: db.
B2 -> =DARABTELI(A:A;A2) Ezt lemásolod a többi városnév mellé.E1 -> db
E2 -> >2
G1 -> VárosMost kijelölöd az A oszlop tartományát, és behívod az irányított szűrést.
- Más helyre másolja
- Listatartomány, amit eleve beír
- Szűrőtartomány $E$1:$E$2
- Hova másolja $G$1OK.
A G oszlopban címsorostúúúl megjelennek a városok, amelyek legalább 3-szor szerepelnek az A oszlopban. Ezt a tartományt kijelölve indítod a kimutatás varázslót. A Város címet a sorokhoz, és az adatokhoz is behúzod, kész.Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Excelbarat
tag
Ebben a hozzászólásban pont erre van válasz!
Annyi módosítást csinálsz, hogy miután ugrással kijelölted az üres cellákat azokat csak törlöd.Egy másik megoldás (lehet inkább ez lenne az ideális neked), hogy B oszlopban beírod ezeket:
B1: 1
B2: 6
B3: 11 (lehúzod ameddig szeretné hogy majd kiírja)
A "C" oszlopban pedig ezt írod:
C1: =INDEX(A:A;B1;1) Így ezzel a "B" oszlop számaival egyező "A" oszlop sorú értéket ad vissza. (ezt is csak végighúzod)
Remélem valamelyik módszer jó lesz.[ Szerkesztve ]
-
Delila_1
Topikgazda
Egy segédoszlop kell hozzá, legyen ez a C.
C1 -> 1
C2 -> =C1+5
A fenti képletet lemásolod.B1 -> =INDIREKT("A"&C1)
Ezt lemásolod, ameddig kell.Szerk.: Míg írtam, Excelbarát kiegészítette az előbbi válaszát.
[ 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.
-
Excelbarat
tag
válasz Bocimaster #16918 üzenetére
Ez megoldja a problémád:
Sub masolo()
Application.ScreenUpdating = False 'kikapcsolja a képfrissítést így gyorsabb
Sheets.Add.Name = "Összes" 'beszúr egy összes nevű lapot
For i = 1 To ActiveWorkbook.Worksheets.Count
Sheets(i).Select
If Sheets(i).Name = "Összes" Then 'ha a lap neve összes akkor ugrik a következőre
Else
Range(Rows(4), Rows(19)).Copy 'kijelöli a 4-től 19-ig a sorokat
Sheets("Összes").Select 'átvált az összes lapra
u = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row 'megkeresi az összes lapon az utolsó sort
Cells(u, "A").Select
Selection.PasteSpecial Paste:=xlPasteValues 'bemásolja
End If
Next i
Application.ScreenUpdating = True 'visszakapcsolja a képfrissítést
End Sub[ Szerkesztve ]
-
Excelbarat
tag
válasz w.miki #16916 üzenetére
A oszlop adatait jobbra rendezed B oszlop adataid balra rendezed és beszúrsz közéjük egy új oszlopot amit feltöltesz kötőjelekkel, plusz még az segíthet ha kikapcsolod a munkalapon a rácsvonalakat vagy esetleg rajzolsz szegélyeket. (az a sok pont csak problémát fog okozni a későbbiekben.... )
-
Bocimaster
csendes tag
válasz Excelbarat #16924 üzenetére
huuu, és huuuu , wow....
köszi, nem semmi...
Az ösztön mindig többet ér az észnél.
-
Mutt
aktív tag
Hello,
Ha Excel 2010-et használsz, akkor könnyedén lehet állítani a tizedesjelet és ezreselválasztót.
File menű -> SpeciálisA többi verzió esetén a Windows területi beállításait kellene módosítani.
Lehet, hogy ez is megoldja a problémádat.Ha mégis csere kell, akkor pedig javaslom hogy egy üres sztringet ("") fűzz az értékhez.
pl. 12,1 -> =HELYETTE(A1;",";".")&"" -> 12.1
Ilyenkor szövegként fogja tárolni a számot, aritmetikai műveleteknél nem fog gondot okozni, de logikai és összehasonlításoknál igen.üdv.
A tanácsaimat ingyen adom. Ha nem tetszik, akkor kérlek ne kritizáld! / https://github.com/viszi/codes/tree/master/Excel
-
w.miki
veterán
válasz Excelbarat #16925 üzenetére
azt gondoltam, hogy valamilyen formátum kóddal is meg lehet oldani, de így is jó, bár nem olyan szép kinyomtatva
Olcsó kütyük: http://tiny.cc/fbkutyu
-
atillaahun
veterán
válasz Delila_1 #16895 üzenetére
Tudnál még segíteni kicsit ebben a makróban?
A tegnapi pár százas mintára mikor ráeresztettem teljesen jól működött, viszont hogy azóta futtattam még további adatbázisokon is, néha megakad.
Run-time error '13':
Type mismatch
hibával, és ha a debug-ra nyomok, akkor az
If InStr(CV, "@") Then
sort jelöli ki sárga háttérrel a VB.
Ilyenkor is lefut valameddig a ciklus, és másol is ki címeket a Munka2-re, de változó helyeken megakad.
Valami hülye karakterek lennének a széttagolt adatbázisban, vagy mit jelent itt nála a mismatch?
Pedig még a tisztít függvényt is direkt végighúztam az egész listán széttagolás előtt.
Mivel sortörésekkel voltak tele az email-ek és ezeket kiszedte, vannak helyek, ahol rengeteg sort egybefűzött, és azok egy cellába kerültek. Lehet ez a baja, hogy túl hosszú bizonyos cellák tartalma, vagy mitől áll fejre?[ Szerkesztve ]
-
Delila_1
Topikgazda
válasz atillaahun #16933 üzenetére
Mikor leáll, Ctrl+g-vel hozd be a VB szerkesztőben az Immediate ablakot. Írd be
?CV.row
Erre válaszként kapsz egy számot, a ciklusváltozónak a sorát. Lépj az Excelbe, és nézd meg ezt a sort. Akár billentyűzetről is kijavíthatod, majd futtathatod tovább a makrót.Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
skoos
őstag
Kedves Guruk, a következö problèmàval àllok szemben:
Van egy több lapból álló excel munkafüzetem.
Az első lap egy összegző lap, melyen szerepel egy oszlopban a többi lap neve, mellette levő oszlopokba pedig szeretném ha a többi lapról átmásolna bizonyos cellákat.
Mivel az első lapon kívül az összes többi lap formanyomtatvány, minden lapról ugyan az a pár cella szükséges.
Azt szeretném ha az első lapon levő „többi lap oszlopban” található nevekből illessze be a hivatkozási függvénybe a nevet. (=’többi lap oszlop’!$X$Y) de ilyenkor csak a cella hivatkozását másolja tovább (=’A1’!$X$Y … ’An’!$X$Y) nem a bele írt szöveget, ettől a képletem hibás lesz és nem hivatkozik jól.
Mi erre a megoldás?Megköszönnèm segìtsègetek,
Sanyi. -
skoos
őstag
válasz Delila_1 #16936 üzenetére
Nagyon köszönöm segítséged! Sajnos még nem sikerült a képlet, de már nagyon közel lehetünk szerintem.
#HIV hibát dobja.
Még egyszer megpróbálom másképp.
Az első lap A oszlopában fel van sorolva: 'munkafüzet 1, munkafüzet 2...munkafüzet n'. Ugyan ilyen nevek alatt van a többi sheet.
Ha a képletet manuálisan megadva =munkafüzet n!$X$X a megfelelő adatot adja. A kérdés az lenne, hogy az A oszlopban található felsorolásból hogyan tudom a képletbe a szöveget és nem a hivatkozást másolni. Tehát hogy ne =A1!$X$Y legyen hanem hogy a cellába beleírt szöveget másolja tovább a képletbe (=munkafüzet n!$X$X)Köszönöm javaslataid.
-
Delila_1
Topikgazda
Az A oszlopban így legyenek a nevek:
'munkafüzet 1'
'munkafüzet 2'A szóközzel tagolt, vagy számjeggyel kezdődő neveket aposztrófok között kell megjeleníteni a felkiáltójel előtt a képletben.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Bocimaster
csendes tag
válasz Excelbarat #16924 üzenetére
köszönöm mégegyszer a segítséget de , van egy hibácska ,
mondjuk az első lapról másolt után a második lapról másolt adatot az előző után kéne hogy rakja, de
nem - az első adagnak az utolsó sora mindig felül íródik az azt követő első sorával.- lenne erre valami megoldás...
nagyon köszönöm
Az ösztön mindig többet ér az észnél.
-
Delila_1
Topikgazda
válasz Bocimaster #16939 üzenetére
Az Cells(u, "A").Select sort írd át Cells(u+1, "A").Select-re.
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 Bocimaster #16941 üzenetére
Az is jó, csak ott több billentyűt kellett volna leütnöm.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
Excelbarat
tag
válasz Bocimaster #16941 üzenetére
Bocs a kellemetlenségért, siettében átsiklottam a +1-en vagyis csak oda gondoltam..., de ahogy látom Delila_1 közben meg is válaszolta.
-
detroitrw
addikt
Sziasztok!
lenne egy furi kérdésem
parancsgombot hogy lehet egy másik gombbal "megnyomni"? (különböző fülön vannak)
-
Excelbarat
tag
válasz detroitrw #16944 üzenetére
Hi!
Csak simán ahhoz is hozzárendeled ugyan azt a makrót. (ha netán ezt szeretted volna)
Ha a parancsgomb Űrlapvezérlő elem akkor jobb klikk rá és makró hozzárendelése, Ha ActiveX vezérlő akkor tervező mód bekapcsol és kétszer ráklikkelsz utána beírod a sub és end sub közé, hogy Call makronév. Remélem segített. -
detroitrw
addikt
válasz Excelbarat #16945 üzenetére
Szia!
ezt írtam be:
Sub CommandButton1_Click()
Call CommandButton2
End Subde nem jó, not defined
-
Salex1
senior tag
Sziasztok! egy kis segítség kellene, meg lehet ezt oldani valahogy:
A lényeg, hogy van egy tábla, amit folyamatosan bővítek kézzel (napi/heti egy két plusz sor) és van egy másik munkalap, amin van egy táblázat,minden sorban dátummal, itt egy függvény nézi, hogy melyik régebbi, mint az aktuális dátum (MA). Az első munkafüzet következő üres sorába kellene átírni annak a nevét, aminek a dátuma lejárt. -
Istv@n
aktív tag
Sziasztok!
Makróban kérnék egy kis segítséget.
Azt szeretném megoldani, hogy egy összesítő fájlba automatikusan kerüljenek be adatok, egy naponta generálódó excel fájlból.
Az nem sikerül, hogy az adatfájlok változó neveire hivatkozzam a makróban. For ciklussal próbáltam, de a változó beírása után hibára fut a program. Próbáltam idézőjelbe írni, aposztrófba, de ugyan az a hiba. Az adatfájl neve mindig a napi dátum éééé-hh-nn_<szöveg>.xlsx Ebből a napot szeretném a ciklusban mindig egyel növelni.Hogyan próbáljam?
-
picsu
csendes tag
Sziasztok!
Egy kis segítségre lenne szükségem. Régen office 2003-am volt amin szuperül működött ez a parancs:
Set fajllista = Application.FileSearchAz új 2007-esben azonban hibát kapok rá... :-(
"Runtime error '445'
Object doesn't support this actionTudnátok segíteni, hogy mivel tudom helyettesíteni?
Előre is nagyon köszönöm.
IstiA makróm ez:
Sub export()Dim elso, masodik, harmadik, negyedik, otodik, hatodik, hetedik As String
Dim fold As FileDialog
Dim foldrv As Variant
Dim fso As Object
Dim fajllista As FileSearch
Dim fajllistaindex As Long
Dim forras, cel As StringApplication.Calculation = xlCalculationManual
Application.ScreenUpdating = Falsecel = ActiveWindow.Caption
Set fold = Application.FileDialog(msoFileDialogFolderPicker)
With fold
If .Show = -1 Then
foldrv = .SelectedItems(1)
Else
Exit Sub
End If
End WithSet fajllista = Application.FileSearch
With fajllista
.NewSearch
.LookIn = foldrv
.Filename = "*.xls"
.SearchSubFolders = False
If .Execute > 0 Then
For fajllistaindex = 1 To .FoundFiles.Count
'MsgBox .FoundFiles(fajllistaindex)
Workbooks.Open Filename:=.FoundFiles(fajllistaindex)forras = ActiveWindow.Caption
'
With Workbooks(forras).Sheets(1)Workbooks(cel).Sheets(1).Cells(fajllistaindex + 5, 1) = Workbooks(forras).Sheets(1).Cells(3, 1)
Workbooks(cel).Sheets(1).Cells(fajllistaindex + 5, 2) = Workbooks(forras).Sheets(1).Cells(3, 2)
Workbooks(cel).Sheets(1).Cells(fajllistaindex + 5, 3) = Workbooks(forras).Sheets(1).Cells(3, 3)
Workbooks(cel).Sheets(1).Cells(fajllistaindex + 5, 4) = Workbooks(forras).Sheets(1).Cells(3, 4)
Workbooks(cel).Sheets(1).Cells(fajllistaindex + 5, 5) = Workbooks(forras).Sheets(1).Cells(3, 5)
Workbooks(cel).Sheets(1).Cells(fajllistaindex + 5, 6) = Workbooks(forras).Sheets(1).Cells(3, 6)End With
'(fajllistaindex, 1) = workbooks(Application.DisplayAlerts = False
Workbooks(forras).Close
Application.DisplayAlerts = True'"=[Book1.xls]Sheet1!R1C1"
'"=[" & .FoundFiles(fajllistaindex) & "]Sheet1!R1C1"Next fajllistaindex
End If
End WithApplication.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.CalculateMsgBox "Na ez is megvan mégsincs este... Összesen " & fajllistaindex & " fájlból importáltunk adatokat.", vbInformation + vbOKOnly, "Komisszióadatok importálása befejeződött"
End Sub
Melyik a kakukktojás? ARANY - PETŐFI - EZÜST
Új hozzászólás Aktív témák
- Milyen TV-t vegyek?
- Gördeszka topic
- Az NVIDIA szerint a partnereik prémium AI PC-ket kínálnak
- Telekom otthoni szolgáltatások (TV, internet, telefon)
- Xbox Series X|S
- Anglia - élmények, tapasztalatok
- Konzolokról KULTURÁLT módon
- BestBuy ruhás topik
- Milyen billentyűzetet vegyek?
- 3D nyomtatás
- További aktív témák...
- Game Pass Ultimate előfizetések 1 - 25 hónapig azonnali kézbesítéssel a LEGOLCSÓBBAN!
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Steames kulcsok jó áron eladóak!
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Canva Pro előfizetés - 1 éves