-
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
-
#22142
Delila_1
veterán
King Unique
#22141
Delila_1
veterán
válasz
King Unique
#22141
üzenetére
Szívesen.
-
#22140
Delila_1
veterán
King Unique
#22139
Delila_1
veterán
válasz
King Unique
#22139
üzenetére
Úgy is jó, de inkább egy feltételbe tenném.
if jelölő=true then
ide jön a minden max értéket színező ciklus
else
ide meg az, ami az első megtaláltat színezi
end ifA jelölő szó helyett a CheckBox-od nevét írd be.
A formon lévő vezérlőkhöz nem modulba írjuk a makrókat. Vezérlőn dupla klikk előhozza a form modullapját, és még a hozzá tartozó makró kezdő-, és utolsó sorát is beírja.
A fenti makrót annak a gombnak a click eseményéhez kell beírnod, ami a max értékeket színezi.
-
#22138
Delila_1
veterán
King Unique
#22137
Delila_1
veterán
válasz
King Unique
#22137
üzenetére
Teheted UserFormra is, nem szükséges a füzet lapjára tenni. A feladatban nem szerepelt a vezérlők helye.
-
#22136
Delila_1
veterán
King Unique
#22135
Delila_1
veterán
válasz
King Unique
#22135
üzenetére
A gombokat és a comboboxot neked kell bevinned a lapra.
Nincs 2013-as verzióm, de valószínű, hogy abban is a Fejlesztőeszközök | Beszúrás | ActiveX -ben találod meg.Az egyes vezérlők nevét (Name) is add meg a tulajdonságuknál úgy, ahogy a makrókat hozzájuk rendeltem.
-
#22134
Delila_1
veterán
King Unique
#22133
Delila_1
veterán
válasz
King Unique
#22133
üzenetére
A füzetben, amit küldtem tegnap, megtalálod.
-
#22132
Delila_1
veterán
King Unique
#22131
Delila_1
veterán
válasz
King Unique
#22131
üzenetére
Fejlesztőeszközök | Vezérlők | Tulajdonságok.
Ilyenkor a Tervező mód legyen érvényben. Ha kész, kapcsold ki a tervező módot.
-
Delila_1
veterán
válasz
enelna
#22123
üzenetére
Ez meg az óraszámot is beírja a H oszlopba:
Sub Szabi_Ora()
Dim sor As Integer, sz As String, hova As Integer
Dim ora As Integer
hova = Columns(5).Find("Szabadság").Row
For sor = 10 To 40
If Cells(sor, "E") = "Szabadság" Then
sz = sz & Cells(sor, "A") & "; "
ora = ora + 8
End If
Next
Cells(hova, "F") = Left(sz, Len(sz) - 2)
Cells(hova, "H") = ora
End Sub -
Delila_1
veterán
válasz
enelna
#22123
üzenetére
Ez a makró beírja:
Sub Szabi()
Dim sor As Integer, sz As String, hova As Integer
hova = Columns(5).Find("Szabadság").Row
For sor = 10 To 40
If Cells(sor, "E") = "Szabadság" Then
sz = sz & Cells(sor, "A") & "; "
End If
Next
Cells(hova, "F") = Left(sz, Len(sz) - 2)
End Sub -
Delila_1
veterán
válasz
enelna
#22118
üzenetére
Másképp oldanám meg. Az A és B oszlopra feltételes formázást adnék, ahol a képlet
=$B1="SZ"
és a háttérszínt pl. pirosra állítanám. Minden sor A és B oszlopában, ahol a B oszlop tartalma SZ, pirosra váltana a háttér.
A szabadságok darabszámát a
=DARABTELI(B:B;"SZ")
képlet adja meg a lapon.
-
#22117
Delila_1
veterán
King Unique
#22116
Delila_1
veterán
válasz
King Unique
#22116
üzenetére
-
#22115
Delila_1
veterán
King Unique
#22114
Delila_1
veterán
válasz
King Unique
#22114
üzenetére
A legördülőnél meg kell adnod, hogy honnan vegye az adatait, ez a ListFillRange tulajdonság. A küldött füzetben Munka1!AA1:AA8. A cellacsatolás az a hely, ahova a kiválasztott érték kerül, LinkedCell, ebben az esetben Munka1!AB1.
Mindkettő akkor igaz, ha az ActiveX vezérlőket használod a lapon. Alkalmazhatod az Űrlapvezérlőket is, ott a tulajdonságainál magyarul írják a két terület nevét.
-
#22113
Delila_1
veterán
King Unique
#22111
Delila_1
veterán
válasz
King Unique
#22111
üzenetére
Bemásoltam innen a makrókat egy füzetbe, elküldöm.
-
#22112
Delila_1
veterán
King Unique
#22111
Delila_1
veterán
válasz
King Unique
#22111
üzenetére
Állandónak ajánlom, és mindenkinek. Sok új függvényt elérsz vele a füzetben, és a VBA-ban is, amik enélkül nem mennek.
A Combobox cellacsatolását betetted az AB1 cellába?
-
#22110
Delila_1
veterán
King Unique
#22109
Delila_1
veterán
válasz
King Unique
#22109
üzenetére
Kapcsold be az Analysis Toolpak és az Analysis Toolpak - VBA nevű bővítményeket.
-
Delila_1
veterán
válasz
csendes
#22105
üzenetére
Egyszer egy ilyen esetben a következőt csináltam (eredménnyel):
Ctrl+g-vel behívtam az Ugrás menüt, ott az Irányított gomb megnyomása után kiválasztottam az Objektumokat. Kijelölt egy nagy halom objektumot, képeket, gombokat, amiknél csak a sarkaikon lévő jelölők látszottak. Nem léptem ki a jelölésből, hanem a Delete gombbal az összeset egyszerre töröltem. Mentés után drasztikusan csökkent a fájl mérete.
A fájl tulajdonosa nem tudta, mikor és hogy kerültek be ezek.
Egy próbát megér. -
#22102
Delila_1
veterán
King Unique
#22101
Delila_1
veterán
válasz
King Unique
#22101
üzenetére
Szívesen.
-
#22100
Delila_1
veterán
King Unique
#22099
Delila_1
veterán
válasz
King Unique
#22099
üzenetére
If CV.Value Like ("[AEIOU]") Then -> ha a ciklusváltozó (CV) egyenlő a LIKE kulcsszó utáni valamelyik karakterrel, akkor...
Az A ASCII értéke 65. Le tudod kérdezni a KÓD függvénnyel. Az i itt egy 1 és 26 közötti véletlen egész szám. A Chr(i+64) egy 65 és 90 közötti értéknek megfelelő karaktert adja, A-tól Z-ig.
A kis a betű ASCII kódja 97, ott az i-hez 96-ot kell adni.
Kulcsszavakat nem adhatunk változónévként, ezért a maxx.
Minden maxx-szal azonos értékű cella színezése:
Range("A1").Select
hely = Selection.CurrentRegion.Address
maxx = Application.Max(Range(hely))
For Each CV In Range(hely)
If CV = maxx Then Range(CV.Address).Font.ColorIndex = 5
Next -
#22097
Delila_1
veterán
King Unique
#22094
Delila_1
veterán
válasz
King Unique
#22094
üzenetére
Második kérdés: a legördülő csatolását az AB1 cellába tettem.
Private Sub General1_Click()
Dim szam As Integer, CV As Object
Dim also As Integer, felso As Integer
Dim hely As String
Range("A1").Select
Selection.CurrentRegion.Font.ColorIndex = 0
Selection.CurrentRegion.ClearContents
szam = Range("AB1")
also = 1: felso = 100
For Each CV In Range(Cells(1, 1), Cells(szam, szam))
Randomize
CV = Round(Rnd * (felso - also) + also, 0)
Next
End SubPrivate Sub Max_Click()
Dim maxx As Integer, hely As String, CV As Object, cim As String
Range("A1").Select
hely = Selection.CurrentRegion.Address
maxx = Application.Max(Range(hely))
cim = Range(hely).Find(maxx).Address
Range(cim).Font.ColorIndex = 5
MsgBox "A maximális érték helye: " & cim & ", " & _
"értéke: " & maxx
End Sub -
#22096
Delila_1
veterán
King Unique
#22094
Delila_1
veterán
válasz
King Unique
#22094
üzenetére
Az első kérdéshez:
Private Sub General_Click()
Dim tomb(26), sor As Integer, oszlop As Integer, i As Integer
Dim usor As Integer, uoszlop As Integer
Dim felso As Integer, also As Integer
Range("A1:Z26").ClearContents
Range("A1:Z26").Font.ColorIndex = 0
Randomize
also = 1: felso = 5
usor = Round(Rnd * (felso - also) + also, 0)
felso = Int(26 / usor)
Randomize
uoszlop = Round(Rnd * (felso - also) + also, 0)
For sor = 1 To usor
For oszlop = 1 To uoszlop
Ujra:
Randomize
felso = 26
i = Round(Rnd * (felso - also) + also, 0)
If tomb(i) > 0 Then GoTo Ujra
tomb(i) = i
Cells(sor, oszlop) = Chr(i + 64)
Next
Next
End SubPrivate Sub Kiemel_Click()
Dim terulet As String, CV As Object
Range("A1").Select
terulet = Selection.CurrentRegion.Address
For Each CV In Range(terulet)
If CV.Value Like ("[AEIOU]") Then CV.Font.ColorIndex = 3
Next
End Sub -
Delila_1
veterán
Ennél az elrendezésnél a 2003-as verzió képlete a G2 cellában:
=HA(HIBÁS(HOL.VAN(A2;J:J;0));"új tétel";HA(INDEX(J:O;HOL.VAN(A2;J:J;0);6)=F2;"maradt";"változott"))
2007-től kicsit egyszerűbb a HAHIBA függvény bevezetése által:
=HAHIBA(HA(INDEX(J:O;HOL.VAN(A2;J:J;0);6)=F2;"maradt";"változott");"új tétel")
-
Delila_1
veterán
válasz
DopeBob
#22062
üzenetére
"a mai naphoz képes egy héten belülre kerül".
Ezt úgy érted, hogy az aktuális dátumhoz képest az 1 héttel előbbi, és 1 héttel későbbi dátumot tartalmazó cellákat akarod formázni? Ha igen, a képlet a lenti (persze ha A1-ben kezdődnek a dátumaid.
=ÉS(A1>=MA()-7;A1<=MA()+7)
-
Delila_1
veterán
válasz
Prancz
#22050
üzenetére
Nevezd el a rövidítéseket tartalmazó tartományt rövidítésre, a magyarázatok 2 oszloposát pedig teljesre. A makrót lefuttatva megkapod az eredményt.
Sub csere()
Dim cv As Object
For Each cv In Range("rövidítés")
Range(cv.Address) = Application.VLookup(cv, Range("teljes"), 2, 0)
Next
End Sub -
Delila_1
veterán
válasz
bepken
#22038
üzenetére
Próbáld ki ezzel:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 Then
Application.EnableEvents = False
On Error GoTo Hiba
If Target.Value <> "" Then
Cells(Target.Row, 2) = Date
Cells(Target.Row, 2).NumberFormat = "yy/mm/dd"
Else
Cells(Target.Row, 2) = ""
End If
Application.EnableEvents = True
End If
Exit Sub
Hiba:
MsgBox "Egyszerre csak egy adatot adj meg, vagy törölj!", vbOKOnly + vbExclamation
Application.EnableEvents = True
End Sub -
-
Delila_1
veterán
válasz
valkesz93
#22032
üzenetére
• Hol adod meg, hogy pl. a B170 tartalmát keresed?
• Ha nem talál, mi legyen?
• Ha a 20. sorban talál azonos értéket, akkor a C20:C170, stb tartományt másolja?
• Hova másoljon? A keresett cella mellé? Most adatok vannak mellette. Felülírja azokat, vagy egy üres oszloptól kezdve valahova? -
Delila_1
veterán
válasz
#02644736
#22031
üzenetére
A lapodhoz kell rendelned a lenti makrót, ennek a módját több helyen megtalálod a fórumon.
Az X1 helyett olyan címet írj, ahol biztosan nincs adatod.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
Application.EnableEvents = False
Range("A1") = Range("X1") + Target
Range("X1") = Range("A1")
Application.EnableEvents = True
End If
End Sub -
Delila_1
veterán
válasz
bepken
#22025
üzenetére
Igen, az a baja.
Egy kicsit másképp a makró. Ebben már az is benne van, hogy egyszer fusson le. Mikor beírsz a lapra valamit, beíródik a B oszlopba a dátum, erre újból lefut az EnableEvents ideiglenes letiltása nélkül.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Value <> "" Then
Cells(Target.Row, 2) = Date
Cells(Target.Row, 2).NumberFormat = "yy/mm/dd"
Else
Cells(Target.Row, 2) = ""
End If
Application.EnableEvents = True
End SubMivel a C oszlop változtatását akarod figyeltetni, érdemes az egészet egy feltételbe beírni.
if target.column=3 then
...
endif -
#22022
Delila_1
veterán
LordVader80
#22021
Delila_1
veterán
válasz
LordVader80
#22021
üzenetére
Szívesen.
-
#22020
Delila_1
veterán
LordVader80
#22019
Delila_1
veterán
válasz
LordVader80
#22019
üzenetére
Most már csak a kibővített feltételt írom be.
If CV > "" Then
CV.Copy
Sheets("Munka2").Range("A" & sor).PasteSpecial xlFormats
Sheets("Munka2").Range("A" & sor).PasteSpecial xlValues
sor = sor + 1
End If -
#22018
Delila_1
veterán
lordeklvin
#22017
Delila_1
veterán
válasz
lordeklvin
#22017
üzenetére
Szívesen.
-
#22016
Delila_1
veterán
LordVader80
#22015
Delila_1
veterán
válasz
LordVader80
#22015
üzenetére
Kiegészítve az üres cellák másolásának elhagyásával:
Sub Egymas_ala()
Dim ter As String, CV As Object, sor As Long
Range("A1").Select '*
ter = Selection.CurrentRegion.Address
sor = 1
For Each CV In Range(ter)
If CV > "" Then
Sheets("Munka2").Range("A" & sor) = CV.Value '**
sor = sor + 1
End If
Next
End Sub -
#22014
Delila_1
veterán
lordeklvin
#22010
Delila_1
veterán
válasz
lordeklvin
#22010
üzenetére
Ezt a szép hosszú képletet tedd egy másik oszlopba, a C-ben meg – ahol a / utáni részt akarod megjeleníteni – hivatkozz erre a segédoszlopra.
-
#22012
Delila_1
veterán
LordVader80
#22011
Delila_1
veterán
válasz
LordVader80
#22011
üzenetére
Az eredeti lapon lévő, A1 cellában kezdődő táblázat adatait másolja a makró a Munka2 lapra abban a sorrendben, ahogy írtad.
Két helyen kell módosítanod a makróban, ahol megjelöltem.
'* ha nem az A1-ben kezdődik a táblázatod, '** ha nem Munka2 a másolat lap neve.Sub Egymas_ala()
Dim ter As String, CV As Object, sor As Long
Range("A1").Select '*
ter = Selection.CurrentRegion.Address
sor = 1
For Each CV In Range(ter)
Sheets("Munka2").Range("A" & sor) = CV.Value '**
sor = sor + 1
Next
End Sub -
Delila_1
veterán
válasz
kopogo
#22006
üzenetére
Az első kérdés megválaszolásához szükséges a füzet ismerete.
A másodiknál érvényesítést kell bevinned, ahol egész számot engedsz meg, minimum érték 1, maximum 5000.
A Hibajelzés fülön a Hibaüzenet rovatban adod meg a szöveget.
Az oszlopra feltételes formázást adsz. Itt a képlet =I1>2000, formátumként pedig beállítod a háttérszínt. -
#22007
Delila_1
veterán
lordeklvin
#22005
Delila_1
veterán
válasz
lordeklvin
#22005
üzenetére
A kép alapján nekem nem egészen tiszta, melyik adatoknak a / jel utáni részét akarod megjeleníteni, és hol.
Vegyük, hogy az adat (6:00/0) a C10-ben van. A képlet
=JOBB(C10;HOSSZ(C10)-SZÖVEG.KERES("/";C10)) -
Delila_1
veterán
válasz
tgumis
#22000
üzenetére
Az Összesítés lap A1 cellája az első-, az A2 az utolsó hónap, amit összesíteni akarsz.
Legegyszerűbb, ha minden lapon egy cellában összesíted az aznapi eladásokat. Legyen ez a példában az N1 cella. Ha a bevételeid a D oszlopban vannak, akkor az N1 képlete =SZUM(D:D).A makró az Összesítés lap B4 cellájába írja be a beírt lapok összbevételét.
Sub Osszesen()
Dim lap%, elso%, ucso%, osszes As Long
elso% = Sheets("Összesítés").Range("A1")
ucso% = Sheets("Összesítés").Range("A2")
For lap% = elso% To ucso%
osszes = osszes + Sheets(lap%).Range("N1")
Next
Sheets("Összesítés").Range("B4") = osszes
End Sub -
Delila_1
veterán
válasz
Pityke78
#21981
üzenetére
Képletek | Definiált nevek | Névkezelő
Megjelennek egy listában a felvitt nevek. Ráállsz a módosítandóra, és lent, a hivatkozás mezőben átírod a területet.
Kicsit furfangosan írták meg az Excel fejlesztői ezt a részt. Legjobb, ha a beírt $A$1:$A$15-ben kijelölöd a második A-t, és átírod B-re, másképp hajlamos annak a cellának a címét beírni, amelyiken éppen állsz a füzetben. -
Delila_1
veterán
válasz
demarad
#21977
üzenetére
A kódot így fejtettem meg:
Kijelöltem és másoltam a szóköznek látszó karaktert, majd beillesztettem egy cellába. Erre a cellára hivatkoztam a KÓD függvénnyel, ami kidobta a 160-at.Erre nincs szükség, hiszen közvetlenül a Csere funkcióhoz is beilleszthetjük a cserélendő karaktert, csak gondoltam, hátha érdekel.
-
Delila_1
veterán
válasz
demarad
#21973
üzenetére
A csatolt füzetedben a látszólagos szóköz igazán egy 160-as kódú láthatatlan karakter.
Állj az egyik ilyen cellára, jelöld ki a szóköznek látszó karaktert, Ctrl+c-vel tedd a vágólapra.
Hívd be a Csere funkciót, és Ctrl+v-vel másold be a vágólapról a Keresett szöveg rovatba. A Csere erre rovatot hagyd üresen, nyomd meg Az összes cseréje gombot.Utána már kedved szerint módosíthatod a tartományod formátumát.
-
Delila_1
veterán
Nálam a formon a két objektum ComboBox1, és Image1 névre hallgat.
A ComboBox1 listáját megadod a RowSource tulajdonságánál, pl. Munka1!A1:A10, ez a tartomány tartalmazza a képfájlok nevét, kiterjesztés nélkül. A Style tulajdonság legyen fmStyleDropDownList, hogy csak a felajánlott nevekből lehessen választani, ne lehessen új tételt beírni.
Az Image1 PictureSizeMode tulajdonsága legyen fmPictureSizeModeZoom, hogy bármelyik kép megjelenítése kitöltse az objektumot.
A makró:
Private Sub ComboBox1_Change()
Dim Fname As String
Fname = "F:\Jpg\Festmenyek\" & ComboBox1 & ".jpg"
Image1.Picture = LoadPicture(Fname)
End SubTermészetesen a saját útvonaladat, és a képeid kiterjesztését add meg az Fname változóban.
-
#21970
Delila_1
veterán
ElemiKoczka
#21969
Delila_1
veterán
válasz
ElemiKoczka
#21969
üzenetére
Privátban megadom a címet.
-
#21968
Delila_1
veterán
ElemiKoczka
#21967
Delila_1
veterán
válasz
ElemiKoczka
#21967
üzenetére
Louro ötletét tartom jónak.
Nem számít, hogy az első tétel C oszlopában mi van. A képletben az =1 nem arra vonatkozik. -
#21965
Delila_1
veterán
ElemiKoczka
#21961
Delila_1
veterán
válasz
ElemiKoczka
#21961
üzenetére
Az A oszlopban az egyes termékek nevéből csak az első legyen látható, a többinél a karakter színe egyezzen meg a cella háttérszínével.
Ez példa arra az esetre, ha nem fogadod meg Louro tanácsát.
-
#21963
Delila_1
veterán
FastEthernet
#21960
Delila_1
veterán
válasz
FastEthernet
#21960
üzenetére
Az idézett linken elolvashatod, hogy alakíthatod át az A oszlopodat úgy, hogy megszünteted a cellák összevonását. A példában B oszlopról van szó, de ez biztosan nem okoz gondot.
Egy feltételes formázással elérheted, hogy a 3 sor közül a felső és az alsó karakterei a háttérszínnel megegyezzenek, így nem zavarnak be az összképbe. A szegélyeket is feltételes formázással határozhatod meg. A2-től lefelé a két formátum:
=A2<>A1 formátum: karakter fehér, szegély felül
=A2<>A3 formátum: karakter fehér, szegély alul -
Delila_1
veterán
-
-
#21936
Delila_1
veterán
Apollo17hu
#21935
Delila_1
veterán
válasz
Apollo17hu
#21935
üzenetére
A kép ahhoz a cellához tartozik, amelyikben a bal felső sarka van. A 3 cella szélességű kép utolsó két cellája már kívül esik a táblázaton, ezt jelezte hibaként.
-
#21934
Delila_1
veterán
Apollo17hu
#21933
Delila_1
veterán
válasz
Apollo17hu
#21933
üzenetére
2010-es verzióban a tulajdonságoknál az "Áthelyezés és átméretezés a cellákkal együtt" opciót kiválasztva rendezésnél követik a cellájukat a beszúrt képek.
-
#21932
Delila_1
veterán
Fire/SOUL/CD
#21931
Delila_1
veterán
válasz
Fire/SOUL/CD
#21931
üzenetére
Segédoszlopokkal tudom csak elképzelni.
Az eredeti tartományból speciális (lánynevén irányított) szűréssel létrehoznék egy újat, ami kiszűri az ismétlődéseket, majd a GYAKORISÁG tömbfüggvényben ezt venném második paraméternek (első az eredeti tartomány).
-
Delila_1
veterán
válasz
slashing
#21921
üzenetére
Az E1 cella tartalmazza a mindenkori utolsó sor értékét.
Előfordul, hogy 1-2 sor cellái üresen maradnak a táblázat fölött, akkor az oszlop üres celláinak a számát add hozzá az E1 képletéhez. Ha 2 üres cella van az A oszlop tetején, az E1 képlete =darab2(a:a)+2
Figyelem! Ha üres cellák is vannak az A oszlopban, az E1 nem az utolsó kitöltött cella sorszámát adja!
-
Delila_1
veterán
válasz
DasBoot
#21919
üzenetére
Talán így érthetőbb:
Ha jobb(g10;1)<>„k” ÉS jobb(g10,1)<>„M” (nincs prefixum a G10 végén)
akkor a cella értéke legyen g10*2*PI()
Ellenkező esetben
ha jobb(g10;1)=”k”
akkor a cella értéke legyen bal(g10;hossz(g10)-1)*2*PI()*1000
ellenkező esetben (itt már csak M lehet az utolsó karakter)
a cella értéke legyen bal(g10;hossz(g10)-1)*2*PI()*1000000
feltétel vége
Feltétel végeLehet még egy halom hiba, például nincs levédve az ellen, ha valaki a szám után egy J karaktert visz be, vagy akár egy szóközt.
-
Delila_1
veterán
válasz
csenor
#21907
üzenetére
A makró, amit egy gombhoz rendelhetsz, az Eredmények lap X oszlopába beírja a csapatok nevét, az Y-ba a pontszámot, mindezt csökkenő sorrendben.
Sub Pont()
Dim sor As Long, usor As Long
Sheets("Eredmények").Select
Columns(13).Copy
Range("X1").PasteSpecial xlPasteValues
Columns(21).Copy
Range("Y1").PasteSpecial xlPasteValues
usor = Range("X" & Rows.Count).End(xlUp).Row
For sor = usor To 2 Step -1
If InStr(Cells(sor, "X"), "csoport") Or Cells(sor, "X") = "" Then
Range("X" & sor & ":Y" & sor).Delete
End If
Next
'Rendezés
usor = Range("X" & Rows.Count).End(xlUp).Row
Columns("X:Y").Select
ActiveWorkbook.Worksheets("Eredmények").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Eredmények").Sort.SortFields.Add Key:=Range( _
"Y1:Y" & usor), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Eredmények").Sort
.SetRange Range("X1:Y" & usor)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("X1:Y1").Insert Shift:=xlDown
Range("X1") = "Csapat": Range("Y1") = "Pontszám"
End Sub -
Delila_1
veterán
Küldöm a másolással, és értékbeillesztéssel kiegészített teszt makrót. Írd át a meghajtó betűjelét!
Sub teszt()
Dim Args As TFindFile, usor As Long, WS As Worksheet
Dim Siker As Boolean, i As Long
With Args
'**************** itt a saját meghajtód nevét írd be! *******
.StartFolder = "F:\"
'****************************************************************
.FileName = InputBox("fájlnév vagy része") & "*"
.Extension = "xlsx"
End With
Siker = FindFile(Args:=Args)
Set WS = ActiveWorkbook.Sheets("Munka1")
If Siker Then
For i = 1 To UBound(Args.Findings)
usor = WS.Range("A" & Rows.Count).End(xlUp).Row + 1
Workbooks.Open FileName:=Args.Findings(i)
Range("Munka1!A1:L7").Copy
WS.Range("A" & usor).PasteSpecial xlPasteValues
ActiveWorkbook.Close
Next
Else
MsgBox "Nincs találat."
End If
If Args.ErrorCount > 0 Then
MsgBox Args.ErrorCount & " probléma merült fel, lásd Hibák munkalap."
End If
End Sub
Új hozzászólás Aktív témák
Fferi50- Windows, Office licencek kedvező áron, egyenesen a Microsoft-tól - Automata kézbesítés utalással is!
- Microsoft és egyéb dobozos retro szoftverek
- Bitdefender Total Security 3év/3eszköz! - Tökéletes védelem.
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - 15% AKCIÓ
- The Elder Scrolls Online Imperial Collector s Edition
- Bomba ár! Dell Latitude E6430 - i5-3GEN I 8GB I 256SSD I HDMI I 14" HD+ I W10 I Garancia!
- Gyári DELL, HP, LENOVO,Asus,Fujitsu laptop töltők, 27% ÁFA
- 2 TB-os Samsung 980 PRO M.2 SSD with heatsink - garanciával
- AKCIÓ! LENOVO ThinkPad P15 Gen 2 munkaállomás - i7 11800H 32GB DDR4 512GB SSD Quadro T1200 W11
- Apple iPhone 13 Pro 256GB,Újszerű,Dobozaval,12 hónap garanciával
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest