-
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
válasz alfa20 #25354 üzenetére
Ez a megoldás nem foglalkozik azzal, hogy milyen nevet kapott a "keresztségben" az új munkalap egyszerűen a sorban a második munkalappal végzi a műveletet:
Sub ful_torol()
regi = ActiveSheet.Name
Sheets(regi).Copy After:=Sheets(1)
Sheets(2).Name = "leotom"
'makró... blabla
Sheets("leotom").Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End Sub -
m.zmrzlina
senior tag
Adott egy tartomány (pl C2:C120) amiben kb 100 darab elem (szöveg) van. A 100 elem 5 különböző értéket vehet fel, vannak üres cellák és értelemszerűen az 5 féle elem mindegyike többször is előfordul.
Az a feladat, hogy le kell cserélni minden elemet egy számra, azonos szöveget azonos számra.
Ezt eddig így csináltam:For Each rngCella In wsKabelo.Range("C2:C129")
If rngCella.Value <> "" Then
If UCase(rngCella.Value) = "ALMA" Then
rngCella.Value = 1
ElseIf UCase(rngCella.Value) = "KORTE" Then
rngCella.Value = 2
ElseIf UCase(rngCella.Value) = "BANÁN" Then
rngCella.Value = 3
ElseIf UCase(rngCella.Value) = "NARANCS" Then
rngCella.Value = 4
ElseIf UCase(rngCella.Value) = "CITROM" Then
rngCella.Value = 5
End If
End If
NextEz rendben működik de több ilyen lista van amelyek ráadásul folyamatosan változnak, tehát nem a legjobb ötlet beleírni a kódba fixen a neveket és a csereértékeket.
Felvittem az összes listát egy másik munkafüzetbe két oszlopból álló tartományokba, majd elneveztem ezeket a tartományokat a Névkezelővel. Ezekben a tartományokban szeretnék keresni makróból a VLOOKUP() fv-nyel a következőképpen:
For Each rngCella In wsKabelo.Range("C2:C129")
If rngCella.Value <> "" Then
rngCella.Value = Application.WorksheetFunction.VLookup(rngCella.Value, _
Workbooks("forrásadatok.xlsx").Names("gyümölcsök"), 2, 0)
End If
Nextesetleg így:
Set rng_gyümölcsök = Workbooks("forrásadatok.xlsx").Names("gyümölcsök")
Set wsKabelo = ActiveSheetFor Each rngCella In wsKabelo.Range("C2:C129")
If rngCella.Value <> "" Then
rngCella.Value = Application.WorksheetFunction.VLookup(rngCella.Value, _
rng_gyümölcsök, 2, 0)
End If
NextSajnos egyik sem működik. Mit szúrok el?
[ Szerkesztve ]
-
m.zmrzlina
senior tag
válasz m.zmrzlina #25459 üzenetére
Ha az objektumváltozót a következőképpen deklarálom akkor megy:
Set rng_gyümölcsök = Workbooks("forrásadatok.xlsx").Names("gyümölcsök").RefersToRange
Set wsKabelo = ActiveSheet
For Each rngCella In wsKabelo.Range("C2:C129")
If rngCella.Value <> "" Then
rngCella.Value = Application.WorksheetFunction.VLookup(rngCella.Value, rng_gyümölcsök, 2, 0)
End If
Next[ Szerkesztve ]
-
m.zmrzlina
senior tag
válasz Fferi50 #25463 üzenetére
Köszönöm eltettem a megoldásokat.
Az első replace-es megoldás most azért nem jó nekem mert pont azt a célt nem valósítja meg ami miatt a Select Case-es szerkezetet le akarom cserélni. A második természetesen jó lesz.
A valódi makróban nem használok ékezetet az csak a illusztrációba került bele.
-
m.zmrzlina
senior tag
válasz Fferi50 #25465 üzenetére
"(De az is csak annyiszor kell lefusson, ahány gyümölcsneved van és nem az egész tartomány cellaszámának megfelelően.)"
Igen de változás esetén itt ugyanúgy át kell írni az egész kódrészletet mint a Select Case-nél, a másodiknál viszont csak a rng_gyümölcsök listát a másik munkafüzetben. Ehhez pedig nem kell tudni programozni és ez volt a cél.
Köszi még egyszer!
[ Szerkesztve ]
-
m.zmrzlina
senior tag
-
m.zmrzlina
senior tag
válasz Agostino #25728 üzenetére
Az alábbi pár sor a kijelölt tartomány minden cellájában leellenőrzi, hogy van-e "!" (felkiáltójel) és ha van akkor egy "*" (csillag v. szorzásjel) karaktert tesz a cellatartalom elejére és végére.
For Each cella In Selection.Cells
If InStr(1, cella.Value, "!") <> 0 Then
cella.Value = "*" & cella.Value & "*"
End If
Next -
m.zmrzlina
senior tag
Feladat a következő.
Le kell ellenőrizni, hogy egy adott munkafüzet meg van-e nyitva. Elérési útja a fájlnévvel együtt a makrót tartalmazó munkafüzetben egy cellában rendelkezésre áll.
Ha meg van nyitva akkor egyik munkalapját deklarálni kell mint objektumváltozót:
Set ws_Akármi = megnyitottmunkafüzet.Worksheets("akármi")
ha nincsen megnyitva akkor előbb megnyitni és utána deklarálni a változót.
Mi ennek a legrövidebb módja?
-
m.zmrzlina
senior tag
Adott egy munkafüzet 5 munkalappal. A fájl mérete 22MB. Van adat a munkalapokon bőven, de nem annyi ami ekkora fájlméretet indokolna.
Ha az összes munkalap minden cellájának a formátumát átállítom Általános-ra akkor a fájlméret 5MB lesz. Ezt a méretet még mindíg nem indookolja a munkalapokon lévő adat. Képletek sincsenek - legalábbis nem többmillió cellában.
Ha a cellák háttérszíneit átállítom Nincs kitöltésre nem változik a fájlméret.
Ha egy adott munkalapot kitörlök a munkafüzetből akkor a fájl 300kB körüli lesz.
Mi okoznat ilyen indokolatlanul nagy fájlméretet?
-
m.zmrzlina
senior tag
válasz m.zmrzlina #26802 üzenetére
Ezekbe a munkafüzetekbe előszeretettel illesztenek be webes felületről esetleg pdf-ből Ctrl+C-Ctrl+V-vel kisebb nagyobb adatmennyiségeket.
-
m.zmrzlina
senior tag
-
m.zmrzlina
senior tag
válasz Delila_1 #26809 üzenetére
Gyanítom, hogy ez valami hibás mentés eredménye lehet.
A hibás oszlopban ugyanis (mint alaposabban megnézve kiderült) egy szűrés eredményét látom de úgy hogy a sorok sorszámozása teljesen folyamatos nem a szűréskor megszokott -"csak a látható sorok sorszámai követik egymást" mintájú.
Ráadásul a C oszlop Szűrés menüjét lenyitva nem is szüntethető meg a szűrés, hogy a teljes adatot lássam.
Ahogy elnézem itt jelentős adatvesztés is van, le kell gyártani a munkafüzetet újra.Köszi a segítséget!
-
m.zmrzlina
senior tag
A problémám a következő: össze kell hasonlítani kér oszlop tartalmát (cellánként egy egy szöveges érték és ha van közöttük különbség akkor a helyet ahol hiba van és a hibák darabszámát egy MsgBox-ban a felhasználó tudomására hozni.
Úgy próbálkozom, hogy tömb változóba írom a két tartományt és a tömb elemein végzem az összehasonlítást de az értékadásnál a "Object doesn't support this property or method." hibaüzenetet kapom
arr_Analist() = wb_Temp.ws_Kabelo.Range(Cells(2, 1), Cells(int_usor, 1))
arr_Digilist() = wb_Temp.ws_Kabelo.Range(Cells(2, int_uoszlop + 1), Cells(int_usor, int_uoszlop + 1))
For intI = 1 To UBound(arr_Analist)
If Trim(arr_Analist(intI, 1)) <> Trim(arr_Digilist(intI, 1)) Then
int_Hibakszama = int_Hibakszama + 1
str_Hibahely = str_Hibahely & intI + 1 & ".sor, "
End If
Next
If int_Hibakszama > 0 Then
MsgBox "Összesen " & int_Hibakszama & " különbség a következő helye(ke)n: " & str_Hibahely
Else
MsgBox "A két lista azonos."
End If -
m.zmrzlina
senior tag
válasz Delila_1 #27424 üzenetére
Ez igaz csak többféle listáról van szó és az összehasonlítani kívánt tartományok hossza változhat illetve a második oszlop mindig máshol van.
Ezért van változóban a tartományok határainak egy része. Ráadásul a munkalapokon (sok-sok)minden mást makró csinál ezért gondolkozom makróban. Valamint az ellenőrzést a makró többi részétől függetlenül is le kell tudni futtatni és nem akarok minden munkaapot felképletezni (nincs is rá lehetőség illetve nem egyszerű.
Ez most makrós feladat.
[ Szerkesztve ]
-
m.zmrzlina
senior tag
válasz Delila_1 #27424 üzenetére
Érdekes mert egy korábbi verziójában a makrónak ez az értékadés csont nélkül lefut:
Dim arrAnalist() As Variant
Dim arrDigilist() As Variant
Dim intHibakszama As Integer
Dim strHibahely As String
Dim intI As Integer
Set wbSpss_kod = ThisWorkbook
Set wsSyntax = wbSpss_kod.Worksheets("SPSS_syntax")
Set wsKabelo = wbSpss_kod.Worksheets("kabelo")
intDigitlista_oszlop = wsSyntax.Range("AB3").Value
intListahossz = wsSyntax.Range("AC3").Value
arrAnalist() = wsKabelo.Range("A2:A" & intListahossz)
arrDigilist() = wsKabelo.Range(wsKabelo.Cells(2, intDigitlista_oszlop), wsKabelo.Cells(intListahossz, intDigitlista_oszlop))Próbáltam igy is átírni az újat de az sem működik.
-
m.zmrzlina
senior tag
Köszi szépen ez is egy jó irány és használható is számomra de továbbra is szeretném megérteni, hogy miért nem megy a tömb értékadás.
Lehet hogy használom is majd a módszert de ez a problémamegoldás a következő viccet juttatja eszembe:
A rendőr közlekedési balesetnél veszi fel a jegyzőkönyvet: "Egy kézfej az árokban. Egy fül a szalagkorláton. Egy fej az úttesten." Amikor ideér, kiabálni kezd:
- Főnök, főnök! Az úttest az egy té vagy két té?
- Nem tudom.
- Jó - válaszol a rendőr, a fejet széles ívben berúgja az árokba. Tovább ír: "Egy fej az árokban". -
m.zmrzlina
senior tag
válasz Fferi50 #27429 üzenetére
Így jön létre a két változó:
str_Teljesnev = Application.GetOpenFilename
If str_Teljesnev = "False" Then
Exit Sub
ElseIf Mid(str_Teljesnev, (InStrRev(str_Teljesnev, "\") + 1), 9) <> Left(str_Szolgnev, 9) Then
MsgBox "Rossz fájlt választottál!"
Exit Sub
Else
Set wb_Temp = Workbooks.Open(str_Teljesnev)
End If
wb_Temp.Worksheets(1).Name = str_MunkalapA
wb_Temp.Worksheets(2).Name = str_MunkalapD
'kabelo munkalapot létrehoz
wb_Temp.Worksheets(str_MunkalapA).Copy before:=wb_Temp.Worksheets(1)
wb_Temp.Worksheets(1).Name = "kabelo"
Set ws_Kabelo = wb_Temp.Worksheets("kabelo") -
m.zmrzlina
senior tag
válasz be.cool #28278 üzenetére
A megoldás nem Ctrl+C - Ctrl+V kompatibilis mert a te munkafüzeted biztosan máshogy néz ki de az elv használható: /a szerkesztőlécen a C1 képletét látod/
A a képlet HOL.VAN(Munka1!A1;Munka2!A:A;0) része megadja, hogy a Munka2 munkalapon melyik sorban van az "A1" cella értéke, az INDEX() fv pedig visszaadja ennek a sornak és a 10. oszolp (ami esetünkben a J oszlop) metszéspontjában lévő cella értékét.
A =HAHIBA() pedig kiirtja a ronda #HIÁNYZIK-ot a Munka1 munkalapról ha Munka1 A oszlopában olyan érték van amit nem talál a Munka2 munkalapon.
-
m.zmrzlina
senior tag
válasz Snoop-y #28284 üzenetére
Teljesen jól látod én csak egy elméleti mintát adtam. Egyenlőre azt sem tudjuk hogy a Munka1 munkalapon /nála biztosan nem ez a neve/ hol kéne megjelennie a másik munkalap cellaértékeinek.
Egyébként az INDEX-MATCH párost rengeteg szakmai fórumon ajánlják a VLOOKUP kiváltására mert sokkal flexibilisebb.
[ Szerkesztve ]
-
m.zmrzlina
senior tag
válasz Snoop-y #28286 üzenetére
Én kivárnám amíg megtudunk több részletet, minek lövöldözzünk vaktában.
Köztünk Delila az aki úgy szokott komplett megoldásokat adni, hogy a hiányzó információkat legenerálja (És még csak nem is haragszik, ha újra és újra át kell írnia a megoldást a csöpögtetett információk alapján)
A CONCATENATE-tal szerintem az lesz a gond, hogy ha a másik munkalapról átvett adatokkal mondjuk számolni akarunk a Munka 1-en akkor az nehézségekbe fog ütközni. De persze ezt is csak feltételezem
-
m.zmrzlina
senior tag
-
m.zmrzlina
senior tag
válasz Claude Leon #28565 üzenetére
Mi történik, ha nem kézzel írod be a $-t hanem F4-gyel?
-
m.zmrzlina
senior tag
Elsőre az alábbi Móricka megoldás jutott eszembe:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$G$3" Or Target.Address = "$H$3" Then
Range("I3").Value = Range("G3").Value * Range("H3").Value
Exit Sub
ElseIf Target.Address = "$I$3" Then
Range("H3").Value = Range("I3").Value / Range("G3").Value
Exit Sub
End If
End SubG3-ban van az ár, H3-ban a darabszám, I3-ban pedig az árbevétel. Ha az árbevételt változtatod akkor az árat fixnek tekinti és a darabszámot adja meg ami az adott áron "belefér" a keretbe.
A makrót az adott munkalaphoz kell rendelni amin a kérdéses cellák vannak és .xlsm-ként elmenteni.
Rémlik még valami Célérték keresés nevű dolog az excelben ami ilyesmire való de azt én még nemigen használtam.
[ Szerkesztve ]
-
m.zmrzlina
senior tag
Próbáld ki ezt:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row >= 3 And Target.Row <= 12 Then
If Target.Column = 7 Or Target.Column = 8 Then
On Error Resume Next
Cells(Target.Row, 9).Value = Cells(Target.Row, 7).Value * Cells(Target.Row, 8).Value
Exit Sub
ElseIf Target.Column = 9 Then
On Error Resume Next
Cells(Target.Row, 8).Value = Cells(Target.Row, 9).Value / Cells(Target.Row, 7).Value
Exit Sub
End If
End If
End Sub[ Szerkesztve ]
-
m.zmrzlina
senior tag
Le kell tiltani az eseménykezelést:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row >= 4 And Target.Row <= 11 Then
Application.EnableEvents = False
If Target.Column = 2 Then
Cells(Target.Row, 4).Value = Cells(Target.Row, 2).Value / 1.044
Cells(Target.Row, 6).Value = Cells(Target.Row, 2).Value / Cells(Target.Row, 5)
ElseIf Target.Column = 4 Then
Cells(Target.Row, 2).Value = Cells(Target.Row, 4).Value * 1.044
Cells(Target.Row, 6).Value = Cells(Target.Row, 2).Value / Cells(Target.Row, 5)
ElseIf Target.Column = 6 Then
Cells(Target.Row, 2).Value = Cells(Target.Row, 6).Value * Cells(Target.Row, 5)
Cells(Target.Row, 4).Value = Cells(Target.Row, 2).Value / 1.044
End If
Application.EnableEvents = True
End If
End Sub[ Szerkesztve ]
-
m.zmrzlina
senior tag
Sőt így talán jobb mert a nullával való osztás nem okoz problémát ha nincsen kitöltve a dbszám/doboz oszlop.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row >= 4 And Target.Row <= 11 Then
Application.EnableEvents = False
If Target.Column = 2 Then
Cells(Target.Row, 4).Value = Cells(Target.Row, 2).Value / 1.044
On Error Resume Next
Cells(Target.Row, 6).Value = Cells(Target.Row, 2).Value / Cells(Target.Row, 5)
ElseIf Target.Column = 4 Then
Cells(Target.Row, 2).Value = Cells(Target.Row, 4).Value * 1.044
On Error Resume Next
Cells(Target.Row, 6).Value = Cells(Target.Row, 2).Value / Cells(Target.Row, 5)
ElseIf Target.Column = 6 Then
Cells(Target.Row, 2).Value = Cells(Target.Row, 6).Value * Cells(Target.Row, 5)
Cells(Target.Row, 4).Value = Cells(Target.Row, 2).Value / 1.044
End If
Application.EnableEvents = True
End If
End Sub[ Szerkesztve ]
-
m.zmrzlina
senior tag
válasz elttiL #28634 üzenetére
Próbáld ezt:
Sub beilleszt()
holavege = Selection.Find(What:="beillesztési pont", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row
Worksheets("Munka1").Range("A" & holavege).PasteSpecial Paste:=xlPasteAll
End SubTermészetesen a Munka1 helyére írd a saját munkalapod nevét!
-
m.zmrzlina
senior tag
válasz elttiL #28644 üzenetére
Ez volt az eredeti kérdésben:
A cellába be van írva, hogy "Beillesztési pont". Ez az A oszlopban bárhol lehet, ide kerül beillesztésre a vágólapon levő tábla
Ez a mostani állapot:
Töküres táblában próbáltam ki,
Azért akad ki mert a töküres táblában sehol nem találja a "Beillesztési pont" cellaértéket.
Azt írod:
no ennek a vágólapon levő táblának az utolsó A oszlopos cellája ugyancsak tartalmazza a "Beillesztési pont" tartalmat,
Írd be az üres táblába A1-be hogy "Beillesztési pont" /kisbetű-nagybetűre figyelj!!!/ és úgy próbáld. Az első beillesztett tartalom után ez már nem fog problémát okozni.
[ Szerkesztve ]
-
m.zmrzlina
senior tag
válasz m.zmrzlina #28647 üzenetére
De ha így próbálod meghatározni az utolsó sort az is működhet.
Sub beilleszt()
holavege = Range("A" & Rows.Count).End(xlUp).Row
Worksheets("Munka1").Range("A" & holavege).PasteSpecial Paste:=xlPasteAll
End SubEz persze csak akkor működik, ha a Beillesztési pont mindig az A oszlop legutolsó cellájában van.
[ Szerkesztve ]
-
m.zmrzlina
senior tag
válasz elttiL #28644 üzenetére
Bocs én voltam a béna.
A:
holavege = Selection.Find(What:="beillesztési pont", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Rowsor helyesen így néz ki:
holavege = Range("A:A").Find(What:="beillesztési pont", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row
Ekkor nem az aktuális kijelölésben keres hanem az A oszlopban.
-
m.zmrzlina
senior tag
válasz elttiL #28650 üzenetére
Akkor még egy javítás. Ha a :
holavege = Range("A:A").Find(What:="beillesztési pont", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row
változatot választod akkor a "beillesztési pont" részt írd át "XXX"-re. Én azt gondoltam, hogy a beillesztési pont maga a cellaérték. Nyilván ezt nem fogja megtalálni ha XXX-szel van megjelölve a vége.
Még egy dolog: ha aaz XXX minden esetben az utolsó sorban van akkor a
holavege = Range("A" & Rows.Count).End(xlUp).Row
változat is működik.
-
m.zmrzlina
senior tag
válasz poffsoft #28655 üzenetére
Az XP-ig része volt a windowsnak egy clipboard viewer de ez úgy tudom a win7-től már nincs. Gondolom vannak ingyenes külső programok a neten erre a célra.
A képet nem tudom milyen formában akarod használni de a szokványos cellatartalmat a szokványos módon lehet hozni-vinni. A teljes sor is egy Range
Új hozzászólás Aktív témák
- Fotók, videók mobillal
- Házimozi haladó szinten
- Épített vízhűtés (nem kompakt) topic
- Amlogic S905, S912 processzoros készülékek
- Nvidia GPU-k jövője - amit tudni vélünk
- Skoda, VW, Audi, Seat topik
- Elfelejtettem a film címét
- TCL LCD és LED TV-k
- Spórolós topik
- Samsung Galaxy Tab S 10.5 - magas képesítés
- További aktív témák...
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: Ozeki Kft.
Város: Debrecen