-
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
-
m.zmrzlina
senior tag
-
m.zmrzlina
senior tag
válasz slashing #23381 üzenetére
Nekem is volt (van) ilyen problémám. Sokat gugliztam meg kérdeztem (itt is) a végén arra jutottam, hogy nem hagyom a vágólapra a tartalmat. Kiírtam (akár rejtett) munkalapra aztán ha kellett visszaolvastam. Lehet hogy nem a legprofibb megoldás de működik.
[ Szerkesztve ]
-
m.zmrzlina
senior tag
válasz m.zmrzlina #23387 üzenetére
Talán egy fokkal jobb, ha kiírod tömbbe. Onnantól fogva van egy változód amit kedved szerint módosíthatsz aztán a végén visszaírod a munkalapra.
-
m.zmrzlina
senior tag
válasz slashing #23393 üzenetére
Én ezt egyszer úgy oldottam meg, hogy az inputboxban megadtam a formáját a neveknek amit elfogad a makró.
technikus = UCase(InputBox("Add meg a technikus nevét!" & Chr(10) "TUDOR VIDOR SZENDE SZUNDI MORGÓ HAPCI KUKA MIND"))
If technikus <> "MIND" Then
If Application.WorksheetFunction.CountIf(Worksheets("PrnWinExcel").range("B:B"), technikus) = 0 Then
MsgBox "Nincs ilyen technikus."
Exit Sub
ElseIf technikus = "" Then
Exit Sub
End If
End IfPersze ez csak akkor működik ha minden elfogadható input ismert a programozás idején, nem bővül vagy egészül ki esetleges elemekkel a Worksheets("PrnWinExcel").range("B:B") tartomány vagy van lehetőség a folyamatos frissítésére.
[ Szerkesztve ]
-
m.zmrzlina
senior tag
Vagy nézd meg ezt:
Sub vaneilyen()
Dim File As String
File = InputBox("Add meg a keresett fájl nevét! (kiterjesztéssel együtt)")
Dim DirFile As String
DirFile = ThisWorkbook.Path & "\" & File
If Dir(DirFile) = "" Then
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=DirFile
'vagy
'Workbooks.Open Filename:=másikfájl
'kitölteni a megfelelő adatokkal
'és menteni a kívánt néven
Else
Workbooks.Open Filename:=DirFile
End If
End SubEz a kód ebben a formájában abban a mappában keres amiben a kódot tartalmazó munkafüzet van.
-
m.zmrzlina
senior tag
Nekem ezzel a kóddal sikerült lemásolnom (Excel 2010 alatt) egy korábbi munkalapon a feltételes formázás színeit:
Sub masol()
For Each cella In Selection.Cells
cella.Offset(0, 10).Interior.Color = cella.DisplayFormat.Interior.Color
Next
End SubEz a kód a kijelölt tartomány minden cellájának (feltételesen és nem feltételesen formázott) színét 10 oszloppal jobbra másolja.
Ja innen loptam, kipróbáltam és működött. (jsmith4892002 2012 aug 19.-i hozzászólása)
[ Szerkesztve ]
-
m.zmrzlina
senior tag
válasz Excelbarat #23421 üzenetére
Ezzel a megoldással csak egy probléma van. Az eredeti kérdés az volt, hogy hogyan lehet feltételesen formázott cellák háttérszíneit lemásolni. Arra pedig ez a kód nem jó.
Amúg szép, ha megengeded használni fogom.
Ha már szinek:
Két rendszergazda beszélget:
-Na milyen az új barátnőd?
-Ne is kérdezd tökéletes. Csúcs ahogy kinéz. 90-60-90
-Nebasz!!! Sötétlila???? -
m.zmrzlina
senior tag
Ugye a legprofibb megoldás gondolom az lenne, hogy egy változóba kiírkálni a cellák DisplayFormat.Interior.Color tulajdonságát majd egy újonnan létrehozott munkalapon visszaírni.
Vagy a másik, hogy ha van elég hely a munkalapodon akkor annyi oszloppal jobbra (vagy sorral lejjebb) másolni a formátumot ahol már nem zavar aztán Ctrl+C > formátum másolása az új munkalapra.
Nyilván te is észrevetted, hogy annyit sántít a megoldás, hogy a nofill (nincs kitöltés) hátterű cellákból fehér (colorindex 2) hátterű cellák lesznek. Nem tudom ez mennyire baj.
-
m.zmrzlina
senior tag
Próbáld ki ezt! Szerintem közel van ahhoz amit szeretnél. Úgy indítasz, hogy kijelölöd azt a tartományt aminek a szineit másolni szeretnéd és elindítod a makrót.
Sub masol()
Dim intSorok As Integer
Dim intOszlopok As Integer
Dim arrCopyColor()
intSorok = Selection.Rows.Count
intOszlopok = Selection.Columns.Count
ReDim arrCopyColor(intSorok, intOszlopok)
For i = 0 To intSorok
For j = 0 To intOszlopok
arrCopyColor(i, j) = Cells(ActiveCell.Row + i, ActiveCell.Column + j).DisplayFormat.Interior.Color
Next
Next
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "colors"
For i = 1 To intSorok
For j = 1 To intOszlopok
Cells(i, j).Interior.Color = arrCopyColor(i, j)
Next
Next
End Sub[ Szerkesztve ]
-
m.zmrzlina
senior tag
válasz Mittu88 #23432 üzenetére
Kijelölt cella értékének változóba írása:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$I$6" Then 'ide jön, hogy melyik celláról van szó
ertek1 = Target.Value
End If
End SubMódosított cellaérték változóba írása:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$I$6" Then 'ide jön, hogy melyik celláról van szó
ertek2 = Target.Value
End If
End Sub -
m.zmrzlina
senior tag
Két kérdés:
A munkalapon közös keretben lévő cellák egyesítve vannak vagy külön cellák csak a keretük közös? (gyanítom külön cellák) Ha van köztük egyesített, melyek azok?
A különböző napokhoz tartozó űrlap részletek nyilván nem véletlenül különböznek. Van rá lehetőség, hogy egységes fejlécet kapjanak?
-
m.zmrzlina
senior tag
válasz -PLevi- #23477 üzenetére
Azt nem tudom, hogy makró nélkül megoldható-e de itt egy példa egy makrós megoldásra:
Sub atszamoz()
Cells(1, 1).Select
i = 1
Do While ActiveCell.Value <> ""
If ActiveCell.EntireRow.Hidden = False Then
ActiveCell.Value = i
i = i + 1
Else
ActiveCell.Value = 0
End If
ActiveCell.Offset(1, 0).Select
Loop
End SubA tartomány kijelölése másképp is megoldható mint itt. A lényeg: végigmész az egész tartományon leellenőrzöd, hogy rejtett-e az aktuális sor és ha nem rejtett adsz neki egy sorszámot. Ezt a makrót minden új szűrés után le kell futtatni.
-
m.zmrzlina
senior tag
válasz -PLevi- #23477 üzenetére
Egy kicsit kecsesebb ez a megoldás de a lényeg ugyanaz mint az előbbinél.
Sub atszamoz()
holavege = Range("A" & Rows.Count).End(xlUp).Row
Cells(1, 1).Select
i = 1
Do While Not ActiveCell.Row > holavege
If ActiveCell.EntireRow.Hidden = False Then
ActiveCell.Value = i
i = i + 1
Else
ActiveCell = Empty
End If
ActiveCell.Offset(1, 0).Select
Loop
End SubEz nem kíván folyamatos tartományt az A oszlopban és nem ír semmit a rejtett sorokba.
[ Szerkesztve ]
-
m.zmrzlina
senior tag
válasz bteebi #23487 üzenetére
Négy irány:
Sub fornext_bjfl() 'balról jobbra fentről le
For i = 1 To 10
For j = 1 To 5
Cells(i, j).Select
Next
Next
End Sub
Sub fornext_jblf() 'jobbról balra lentről fel
For i = 10 To 1 Step -1
For j = 5 To 1 Step -1
Cells(i, j).Select
Next
Next
End Sub
Sub fornext_jbfl_() 'jobbról balra fentről le
For i = 1 To 10
For j = 5 To 1 Step -1
Cells(i, j).Select
Next
Next
End Sub
Sub fornext_bjlf() 'balról jobbra lentről fel
For i = 10 To 1 Step -1
For j = 1 To 5
Cells(i, j).Select
Next
Next
End SubRemélem nem írtam el.
-
m.zmrzlina
senior tag
Adott 2 munkalap. Mindkettőn azonos számú sorból de változó számú oszlopból álló tartományok. Egy harmadik munkalapra össze szeretném másolni ezeket egymás mellé (azonos a sorok száma ugyebár)
Így próbálom:
1. az első munkalapot lemásolom és "összesítő" néven hozzáadom a munkafüzethez
2.meghatározom az első üres oszlop számát és változóba írom (erre a változóra később még szükség lesz)
elsoures_oszlop = wsOsszesito.Range("A1").CurrentRegion.Columns.Count + 1
3. Másolok(nék)
wsTemp.Range("A1").CurrentRegion.Copy Destination:=wsOsszesito.[B]???????[/B]C][/M]
Hogyan jelölöm ki a legegyszerűbben a célterületet? -
m.zmrzlina
senior tag
-
m.zmrzlina
senior tag
Szerintem ez a feladat egyszerűen megoldható (feltéve, ha jól értem a problémát).
Tegyük fel, hogy nagyjából úgy néz ki a munkafüzeted ahogy kettővel lejjebb Wyll lerajzolta
Csinálsz egy munkalapot ebbe a munkafüzetbe, legyen a neve mondjuk "összesítő"Erre a munkalapra kialakítod a számodra legmegfelelőbb szerkezetet és a megfelelő helyekre behivatkozod azokat a cellákat aminek a tartalmát látni szeretnéd.
A képen most a cellák képleteit látod de ha beírod a képletetet akkor a hivatkozott cella tartalmát fogod látni.
-
m.zmrzlina
senior tag
A következő kérdésem lenne:
Van egy munkafüzetem abban van egy makró ami 4-5 jól ekülöníthető dolgot csinál. Elindítom a makrót szépen lineárisan elejétől a végéig lefut megteszi a dolgát, mindenki örül.
Néha azonban szükség van arra, hogy a teljes makrónak egyes részeit többször, külön is le lehessen futtatni (pl hogy két tartomány egyezőségét leelenőrizze) illetve vannak részek amiket kifejezetten nem szeretnék mindig lefuttatni többször (pl a forrás munkalapok más munkafüzetekből való importálására csak egyszer van szükség)
Az a tervem, hogy a teljes kódot egyetlen modulon belül kisebb eljárásokra szabdalom szét és ezekhez az eljárásokhoz külön parancsikonokat teszek a gyorsindítás eszköztárra.
Itt kezdődik a probléma mivel az egyes eljárások jórészt ugyanazokat a változókat használják.
Milyen tipusú változók kellenek és hogyan kell ezeket az eljárások között adni-venni?
Tudom, ez a téma sokkal bővebb mintsem egy válaszban minden részét ki lehetne vesézni, de nekem már az is sokat segít, ha valaki "irányba állít" és 600 oldal manual helyett csak pl 50-et kell elolvasnom.
[ Szerkesztve ]
-
m.zmrzlina
senior tag
-
m.zmrzlina
senior tag
válasz Fferi50 #23545 üzenetére
Jól gondolom, hogy ha a munkalapra kiírós megoldást választom akkor az objektumváltozókat sem kell Public-ként deklarálni csak minden eljárás elején (persze csak ami használja ) értékadással kell kezdeni? Pl:
Dim wsOsszesito as Worksheet
.
.
Sub makro1()
Set wsOsszesito = ThisWorkbook.Worksheets("összesítő")
.....
End Sub[ Szerkesztve ]
-
m.zmrzlina
senior tag
válasz sedyke #23547 üzenetére
A tiédhez nagyon hasonló probléma volt itt.
-
m.zmrzlina
senior tag
válasz Mittu88 #23558 üzenetére
Az volt a probléma, hogy volt egy kezdőérték, lefutott a teljes kód aminek során megváltozott és ennek a kódnak egy részét szeretném újra futtatni.
Namármost: a kezdeti értéket nem adhatom meg a részkód futtatásánál mert ha már egyszer lefutott a teljes kód akkor már nem megyek semmire azzal az értékkel. Ha viszont itt adok értéket neki akkor meg a teljes kód futtatásánál kavar be.
De mindegy is Fferi50 tippje alapján fogok boldogulni a problémával.
Köszi mindenkinek aki segített.
[ Szerkesztve ]
-
m.zmrzlina
senior tag
-
m.zmrzlina
senior tag
Így próbálok feltölteni adattal két tömböt:
arrAnalist() = wsKabelo.Range("A2:A" & intListahossz)
arrDigilist() = wsKabelo.Range(Cells(2, intDigitlista_oszlop), Cells(intListahossz, intDigitlista_oszlop))Ha nem az a munkalap aktív amelyikről az adatokat a tömbbe kell írni akkor a második sornál a "worksheet objektum range metódusa hibás" hibaüzenetet kapom. Az első sor gond nélkül lefut.
Ha a két sor elé beteszem, hogy:
wsKabelo.Select
akkor mind a két sor hiba nélkül megy.Mi lehet az oka?
[ Szerkesztve ]
-
m.zmrzlina
senior tag
válasz Hyper84 #23590 üzenetére
Én eltárolnám egy oszlopba azokat a fejlécelemeket amelyek oszlopát tötölni kell majd egy for each next-tel és egy =CountIf()-fel végigmennék a fejlécen. Ahol a =CountIf() 1-et ad vissza ott törölném az egész sort.
Ha teszel be egy képet a munkalapodról (vagy legalább leírod, hogy hogyan néz ki) konkrétabb is tudok lenni.
-
m.zmrzlina
senior tag
válasz Hyper84 #23592 üzenetére
1. Létrehoztam egy munkalapot a "torolni" néven
2. Ennek a munkalapnak az A oszlopába felvittem azokat az elemeket amelyeknek az oszlopát törölni kell
3. A munkalap amin a törlendő adatok vannak "adatok " nevet kapott
4. A For Each sor végén lévő Range("A1:Z1") azt a tartományt jelöli ameddig a te adataid tartanak az "adatok" munkalapon.Sub oszlop_torol()
Dim rngTorolni As Range
Dim rngCella As Range
Dim wsAdatok As Worksheet
Set wsAdatok = ThisWorkbook.Worksheets("adatok")
Set rngTorolni = ThisWorkbook.Worksheets("torolni").Range("A:A")
For Each rngCella In wsAdatok.Range("A1:Z1")
If Application.WorksheetFunction.CountIf(rngTorolni, rngCella) = 1 Then
rngCella.EntireColumn.Delete
End If
Next
End Sub -
m.zmrzlina
senior tag
válasz m.zmrzlina #23597 üzenetére
Ehhez a módszerhez mindenképp kell egy tartomány amiben a "halálra ítélt" azonosítók vannak.
Meg lehet fordítva is csinálni de akkor a maradó azonosítók listája kell és a Countif() nulla értékénél kell törölni.
Ugyanaz csak pepitában.
[ Szerkesztve ]
-
m.zmrzlina
senior tag
válasz Hyper84 #23599 üzenetére
A "torolni " munkalap A oszlopába nem a s01... stb-t írod hanem az A01.... stb-t és a
If Application.WorksheetFunction.CountIf(rngTorolni, rngCella) = 1 helyett
If Application.WorksheetFunction.CountIf(rngTorolni, rngCella) = 0 lesz
A többi ugyanaz.
Azt gondolom mondani sem kell, hogy legyen a fáljból biztonsági másolatod. -
m.zmrzlina
senior tag
válasz Delila_1 #23618 üzenetére
Én tudom, hogy olyan vagyok mint Móricka akinek mindenről AZ jut az eszébe de ez tényleg csak pár sor makró. Feltéve ha nincsen képlettel előállított cellaérték mert a képletet felül fogja írni a cellaértékkel. Bár ha a Word-ös megoldás működött akkor ez is fog.
Sub nagybetu()
For Each cella In Selection.Cells
If Not IsEmpty(cella) Then
cella.Value = UCase(cella.Value)
End If
Next
End Sub -
m.zmrzlina
senior tag
válasz m.zmrzlina #23633 üzenetére
Az "A" munkafüzet két eseményében lévő makró. Természetesen lehet cizellálni őket (főleg az _Open-t) de az elv az ez.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
Dim wb As Workbook
mappa = ThisWorkbook.Path & "\"
For Each wb In Workbooks
If wb.Name <> ThisWorkbook.Name Then
wb.SaveAs Filename:=mappa & wb.Name
wb.Close
End If
Next wb
Application.DisplayAlerts = True
End Sub
Private Sub Workbook_Open()
Workbooks.Open ThisWorkbook.Path & "\B.xlsx"
Workbooks.Open ThisWorkbook.Path & "\C.xlsx"
End Sub -
m.zmrzlina
senior tag
válasz opzozi #23676 üzenetére
C1-ben van a felső küszöb, B1-ben az alsó:
=DARABHATÖBB(A1:A13;">" & B1;A1:A13;"<" & C1)
ugyanez számokkal megadva:
=DARABHATÖBB(A1:A13;>2;A1:A13;<5)
C1-D1-ben van a két küszöb, E1 az igen/nem B oszlopban az igen/nemek
(ha nagyobb C1-nél és kisebb D1-nél és )=DARABHATÖBB(A1:A13;">" & C1;A1:A13;"<" & D1;B1:B13;E1)
[ Szerkesztve ]
Új hozzászólás Aktív témák
- D1Rect: Nagy "hülyétkapokazapróktól" topik
- E-roller topik
- Ubiquiti hálózati eszközök
- Politika
- ThinkPad (NEM IdeaPad)
- Hobby elektronika
- Skoda, VW, Audi, Seat topik
- A Biden-kormányt is zavarja a big tech és az adatközpontok energiaéhsége
- Autós topik látogatók beszélgetős, offolós topikja
- Filmvilág
- További aktív témák...
- AKCIÓ! - STEAM kulcsok / Punch Club, Oddworld: Soulstorm, Children of Morta, stb. - 2024.05.16.
- Számlás!Steam,EA,Epic és egyébb játékok Pc-re vagy XBox!
- Windows 10 11 Pro Office 19 21 Pro Plus Retail kulcs 1 PC Mac AKCIÓ! LEGOLCSÓBB! Automatikus 0-24
- Vírusirtó, Antivirus VPN kulcsok
- Megmaradt - Eredeti Humble, Choice - Steam kulcsok
Állásajánlatok
Cég: Ozeki Kft.
Város: Debrecen
Cég: Alpha Laptopszerviz Kft.
Város: Pécs