-
GAMEPOD.hu
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 smallmer #37499 üzenetére
Kijelölöd a másolni valót, Ctrl+c, a másolat helyére állsz, jobb klikk, Irányított beillesztés, Képletet.
Vagy a másolás után Kezdőlap (menü), Beillesztés, Képletek.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
csongi
veterán
Sziasztok!
Meg lehet oldani olyat, hogy ha B2 cella értéke Fehér, akkor a c2 cellába egy adott kép(Jpg) jelenjen meg?
Vagy B2 Cella=Kék akkor egy másik kép jelenlen meg a C2 cellába?
Office 2010.Előre is köszi!
-
szabonagyur
félisten
-
Fferi50
őstag
válasz csongi #37506 üzenetére
Szia!
Mitől fehér és mitől kék? Vagyis mi okozza a cella színeváltozását? Ha feltételes formázás, akkor talán az értékhez kötve megvalósítható a munkalap Change eseményében.
Ha csak "úgy", a felhasználó színezi, akkor automatikusan nem fog menni, max. gombnyomásra.
De mindkét esetben makró kell hozzá.Üdv.
-
Fferi50
őstag
válasz szabonagyur #37507 üzenetére
Szia!
Talán megpróbálhatnád a kombinált diagramot. Az alapadatok vonal, a szélső értékek pedig oszlop diagram formájában.
Üdv.
-
tzimash
őstag
Sziasztok,
van egy string változóm, ami egy textboxból kap értéket, a textboxba az adatok vonalkódolvasóból kerülnek.
A vonalkódok mindig Y-nal kezdődnek, amelyet 12 számjegy követ. Pl.: Y010902581309
A probléma akkor kezdődik, ha a kedves felhasználó nem angol területi beállításokat alkalmaz, így az Y-ból könnyen Z lesz, a nullákból pedig ö.
Hogyan lehet megoldani, ha a stringben Z vagy ö betű van, az ki legyen cserélve Y-ra ill. 0-ra?
Replace jó erre?[ Szerkesztve ]
-
holden72
tag
Sziasztok,
Excelben van egy táblázat, melynek első oszlopában nevek szerepelnek (nem ABC sorrendben vannak a nevek).
Hogyan lehet lekérdezni, melyik függvénnyel, hogy hányadik a névsorban az egyik név?
Előre is nagyon köszönöm![ Szerkesztve ]
-
Kobe
veterán
sziasztok
van egy vezérlő űrlapom, amin a felhasználó kiválaszthatja, hogy milyen user nevekre és miylen státuszú tételekre szeretne egy riportot futtatni. Van pl 15 user, és 10 státusz, ő maga összeválogathatja, hogy mire akarja futtatni
Ezt úgy oldottam emg, hogy vannak LsitBox ok a formon, az egyikben megjelenik az összes választható, és a user átmozgatja a kiválasztott tételeket egy üres ListBox ba
Ezután futtatja a riportot. A nyers riportból pedig kitörlődik midnen olyan felhasználó és státusz sora ami nincs benne a választásban.
Eddig úgy oldottam ezt meg hogy egy háttér-worksheeten tároltam ezeket az értékeket, és onnan olvastam ki mi nem kell, és ami nem felelt meg, annak a sorát törölte:
Dim WF As WorsheetFunction
Set WF = Application.WorksheetFunction
'LR = Cells(Rows.Count, 2).End(xlUp).Row
For i = LR To 2 Step -1
If WF.CountIf(ThisWorkbook.Worksheets("Usernames").Range("A2:A20"), Range("B" & i)) + WF.CountIf(ThisWorkbook.Worksheets("Usernames").Range("A2:A20"), Range("C" & i)) = 0 Then
Rows(i).EntireRow.Delete Shift:=xlUp
End If
Next i
Application.ScreenUpdating = Trueezt szeretném átírni úgy, hogy ne a worksheet Range-re kelljen hivatkozni, hanem a Username nevű Form ListBox2-es listboxában található értékekre:
If WF.CountIf(ThisWorkbook.Worksheets("Usernames").Range("A2:A20"), Range("B" & i)) + WF.CountIf(ThisWorkbook.Worksheets("Usernames").Range("A2:A20"), Range("C" & i)) = 0 Then
Rows(i).EntireRow.Delete Shift:=xlUptudna valaki segíteni ezzel?
-
Kobe
veterán
válasz Fferi50 #37523 üzenetére
Mert egy user neve a ket oszlop barmelyikeben elofordulhat (az oszlopok kulonbozo szerepkorokre utalnak, es ahol a ketto vmelyikeben talalat can, az a sor marad
Igazabol nem a 2 feltetel figyelese okoz gondot (mind a ket oszlopnal ugyanannak a listboxnak az ertekeit kellene nezni) hanem a range listboxra cserelese -
Fferi50
őstag
Szia!
A következőt javaslom: a listbox listáját átalakítjuk szöveggé és ebben keressük az adott nevet.
Dim szuro as string ' ez természetesen csak egyszer kell, valahol máshol előtte is lehet.
szuro=Join(Application.Transpose(ListBox2.List), ";")
If szuro Like "*" & Range("B" & i) & "*" Or szuro Like "*" & Range("C" & i) & "*" Then
Rows(i).EntireRow.Delete Shift:=xlUpÜdv.
[ Szerkesztve ]
-
Kobe
veterán
válasz Fferi50 #37525 üzenetére
megoldottam egyszerűbben, kiirattam a listbox értékeit egy ideiglenes táblába és onnan beolvasom/leürítem az ideiglenes táblát
Viszont imádom amikor az ember összerak egy komplett eszközt és a legutolsó mozzanatnál az egész elkezd ActiveX object control hibákat dobni, a relative komplex formom addig flottul működő gombjaitól egész egyszerűen meghal ay Excel, kifagy....
-
dellfanboy
senior tag
mi okozhatja az a hibat az fkeres vlookup alkalmazasa kapcsan hogy eredmenynek n/a-t kapok?
sima fv 1 erteket keresek 1 tablaban ami melle rendeli a tabla 3. oszlopat, nincs duplikacio semmi megis ha fv-t hasznalok az eredmeny n/a mig ha siman ctrl f-el rakeresek az ertekre a tablaban megtalalom 1 alkalommal..
value not available. megneztem a cellaformatumon mindenhol number...eladó dolgok:mondd az árát és vidd http://hardverapro.hu/tag/dellfanboy#aprohirdetesei
-
Fferi50
őstag
válasz dellfanboy #37527 üzenetére
Szia!
Valószínűleg mégsem azonos a keresett érték a táblázatban levővel. Erről meggyőződhetsz, ha a táblázatból átmásolod az értéket a keresőhöz, vagy fordítva.
Az Fkeres 0 negyedik paraméter esetén pontos egyezőséget keres, míg a Ctrl+F -nek elég a részleges is.Üdv.
-
dellfanboy
senior tag
válasz Fferi50 #37528 üzenetére
koszi
igen azt neztem hogy a szemem kaprazik-e vagy nem. de mind a ket ertek ua. ezek id-k raadasul meg a cella formatumot is number-ra raktam mind az ertek es a keresett tabla neveben is.
szoval amikor ctrl f-el keresem akkor u.a. az ertek es meg a formatum is stimmel (2tizedes, szam,)eladó dolgok:mondd az árát és vidd http://hardverapro.hu/tag/dellfanboy#aprohirdetesei
-
Delila_1
Topikgazda
válasz dellfanboy #37529 üzenetére
Nem elég a formátumot átállítani, a cella értéket is újra le kell enterezni a szerkesztőlécen.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
tgumis
tag
sziasztok
Ismét makró összefűzéssel kapcsolatos problémába ütköztem
adott két makró:
1.(ezzel másolok a bevitel munkalapról)Sub D2_T_szurt_taromany_masol()
'
' munkalap védettség feloldás
Sheets("bevitel").Unprotect Password:="pw"
' szűrés
Sheets("bevitel").Range("D2").Activate
Sheets("bevitel").ListObjects("bevitel").Range.AutoFilter Field:=17, Criteria1:="=OK", Operator:=xlAnd
usor = Range("D2").End(xlDown).Row
' munkalap védetté tétele
Sheets("bevitel").Protect Password:="pw", UserInterfaceOnly:=True, AllowFiltering:=True, AllowFormattingColumns:=True
' másolás
Range("D2:T" & usor).Select
Selection.Copy
End Sub2. ezzel illesztem be az előző makróval kimásolt tartományt de egy másik munkalapra aminek a neve összesítés ÖSSZESÍTÉS
Sub beilleszt()
Dim Bsor As Long
Dim Csor As Long
Dim i As Integer
Bsor = Range("B" & Rows.Count).End(xlUp).Row + 1
Range("C" & Bsor).PasteSpecial xlPasteValues
Csor = Range("C" & Rows.Count).End(xlUp).Row + 1
Range("T2:W2").Copy Destination:=Range("T" & Bsor & ":T" & Csor - 1)
For i = Bsor To Csor - 1
Range("B" & i) = Range("B" & i - 1) + 1
Next i
With Range("B1").CurrentRegion
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
End With
End SubSzóval a bevitel munkalapon állva indítanám a makrót és neki automatikusan át kellene rakni az összesítés munkalapra az egészet. plusz ráadásnak még szeretném a végén mindegyik munkalapot visszakódolni és a bevitelnél a törlést alkalmazni egy tartományban amire már kész a makró:
Sub bevitel_torol()
' bevitel munkalapon törlés Makró
' munkalap védettség feloldás
Sheets("bevitel").Unprotect Password:="pw"
' szűrés kikapcsolása
Sheets("bevitel").ListObjects("bevitel").Range.AutoFilter Field:=17
' munkalap kijelölt celláiból érték törlése majd visszaállás az A2
Range("D2:E200,G2:G200,H2:I200").Select
Range("H2").Activate
Range("D2:E200,G2:G200,H2:I200,B1:B6").Select
Range("B1").Activate
Selection.ClearContents
Selection.ClearContents
' munkalap védetté tétele
Sheets("bevitel").Protect Password:="LiliLufi140127", UserInterfaceOnly:=True, AllowFiltering:=True, AllowFormattingColumns:=True
End Subösszegezve:
tartomány szűrése másolásra majd átugrás másik munkalapra ott beillesztés keretezés majd visszaugrás a bevitel munkalapra és ott törlés. Majd minden munkalapot lekódolok. ha lehet munkalaponként kódolást szeretnék nem egyben a munkafüzetet.[ Szerkesztve ]
-
Delila_1
Topikgazda
válasz tgumis #37532 üzenetére
A lenti sor a MAKRÓ részére feloldja a lap védettségét.
Sheets("Lapneve").Protect Password:="pw", UserInterfaceOnly:=True
Ha előtte nem volt levédve a lap, akkor a beírt jelszóval védetté teszi.
Minek ehhez 3 makró? Eggyel is meg lehet oldani. Arra kell ügyelned, hogy a jelszó a bevitel lapon a makró végén megváltozik (pw-ről LiliLufi140127-re), legközelebb indításkor az újat kell megadnod.
Sub Szur_Masol_Torol()
Dim usor As Long, WSBev As Worksheet, WSOsz As Worksheet
Dim Bsor As Long, Csor As Long
'értékadások
Set WSBev = Sheets("bevitel")
Set WSOsz = Sheets("ÖSSZESÍTÉS")
Bsor = WSOsz.Range("B" & Rows.Count).End(xlUp).Row + 1
WSBev.Protect Password:="pw", UserInterfaceOnly:=True
WSOsz.Protect Password:="pw", UserInterfaceOnly:=True
'szűrés OK-ra
WSBev.ListObjects("bevitel").Range.AutoFilter Field:=17, Criteria1:="=OK"
'másolás és érték beillesztés
usor = WSBev.Range("D2").End(xlDown).Row
WSBev.Range("D2:T" & usor).Copy
WSOsz.Range("C" & Bsor).PasteSpecial xlPasteValues
'képlet, majd érték beillesztés a B oszlopba
Csor = WSOsz.Range("C" & Rows.Count).End(xlUp).Row
WSOsz.Range("B" & Bsor & ":B" & Csor) = "=B" & Bsor - 1 & "+1"
WSOsz.Columns(2).Copy
WSOsz.Range("B1").PasteSpecial xlPasteValues
Application.CutCopyMode = False 'kijelölés megszüntetése
With WSOsz.Range("B1").CurrentRegion 'keretezés
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
End With
WSBev.ListObjects("bevitel").Range.AutoFilter Field:=17 'OK-ra szűrés megszüntetése
WSBev.Range("D2:E200,G2:G200,H2:I200,B1:B6").ClearContents 'törlés
'új jelszó a bevizel laphoz
WSBev.Protect Password:="LiliLufi140127", UserInterfaceOnly:=True, _
AllowFiltering:=True, AllowFormattingColumns:=True
End Sub[ 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.
-
tgumis
tag
válasz Delila_1 #37533 üzenetére
Köszi a gyors segítséget
viszont a T2:w2 ben lévő képletek másolását kihagytad azt hová kell beraknom?
Az eredeti makróban így van:Range("T2:W2").Copy Destination:=Range("T" & Bsor & ":T" & Csor - 1)
(legalább is azt hiszem ez az a rész ami megmondja a makrónak hogy másolja le azt a 3 oszlopnyi képletet)[ Szerkesztve ]
-
Delila_1
Topikgazda
-
tgumis
tag
Az összesítés munkalapról
És igen rosszul írtam mert 4 oszlopnyi.
Nem egy oszlopba szeretném hanem addig ameddig tart a beillesztések után a táblázat
Csak gondoltam ez a legcélszerűbb ha a 2. sorból veszi a képleteket:
tehát a összesítés munkalap T2 ből másolja a összesítésT3 ba U2 ből U3 ba és így tovább addig ameddig a beillesztés után adatot tartalmaz
T2=HA(O2="Kiadás";G2*-1;G2)
U2=C2&"_"&D2&"_"&F2&"_"&H2
V2=HAHIBA(INDEX(készleinformációk[Induló_készlet_készlet];HOL.VAN(U2;készleinformációk[Induló_készlet_KOD_ECSK_KLCS_EAZ];0));0)
W2=V2+SZUMHA($U$2:U2;U2;$T$2:T2)
[ Szerkesztve ]
-
tgumis
tag
Abban tudnátok segíteni hogy azt hogy kell megoldani, hogy egy üzenet jelenjen meg a makró indítása után ami rákérdez :
biztos átvigyem az adatokat?
igen
nem
és ha az igenre kattint akkor átmegy ha nem akkor leáll a makrómármint hová kell helyezni a makrómban
Sub atvitel_enged()
Dim iAnswer As Integer
iAnswer = MsgBox("Áttölthetem az adatokat", vbYesNo Or vbQuestion)
End Sub -
logitechh
csendes tag
válasz tgumis #37538 üzenetére
Neked erre van szükséged
Nem olyan stílusos mint Delila_1 megoldása de funkciójában ez tökéletesen működikSub szur_masol_beilleszt_torol()
Sheets("bevitel").Unprotect Password:="pw"
Sheets("összesítés").Unprotect Password:="pw"
Sheets("összesítés").Select
Rows("1:1").Select
Selection.AutoFilter
Selection.AutoFilter
Sheets("bevitel").Select
Sheets("bevitel").Range("D2").Activate
Sheets("bevitel").ListObjects("bevitel").Range.AutoFilter Field:=17, Criteria1:="=OK", Operator:=xlAnd
usor = Range("D2").End(xlDown).Row
Range("D2:T" & usor).Select
Selection.Copy
Sheets("összesítés").Select
Dim Asor As Long
Dim Bsor As Long
Dim i As Integer
Asor = Range("A" & Rows.Count).End(xlUp).Row + 1
Range("B" & Asor).PasteSpecial xlPasteValues
Bsor = Range("B" & Rows.Count).End(xlUp).Row + 1
Range("S2:V2").Copy Destination:=Range("S" & Asor & ":S" & Bsor - 1)
For i = Asor To Bsor - 1
Range("A" & i) = Range("A" & i - 1) + 1
Next i
With Range("A1").CurrentRegion
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
End With
Sheets("összesítés").Protect Password:="pw", UserInterfaceOnly:=True, AllowFiltering:=True,
AllowFormattingColumns:=True
Sheets("bevitel").Select
Sheets("bevitel").ListObjects("bevitel").Range.AutoFilter Field:=17
Range("D2:E200,G2:G200,H2:I200").Select
Range("H2").Activate
Range("D2:E200,G2:G200,H2:I200,B1:B6").Select
Range("B1").Activate
Selection.ClearContents
Selection.ClearContents
Sheets("bevitel").Protect Password:="pw", UserInterfaceOnly:=True, AllowFiltering:=True,
AllowFormattingColumns:=True
End SubA message bax-al történő makró vezérlése viszont engem is érdekel. Szóval ha igen lefusson a makró ha nem akkor meg nem. Arra tud valaki olyan példát amiből ki lehet ezt venni és más makrókhoz felhasználni
-
Delila_1
Topikgazda
válasz tgumis #37537 üzenetére
A makró elejére beírtam a kérdést, a vége felé meg ott van a képletek másolása.
Sub Szur_Masol_Torol()
Dim usor As Long, WSBev As Worksheet, WSOsz As Worksheet
Dim Bsor As Long, Csor As Long, valasz
valasz = MsgBox("Áttölthetem az adatokat?", vbYesNo + vbQuestion, "Választás")
If valasz = vbNo Then Exit Sub
'lapok védelmének feloldása a makró számára
WSBev.Protect Password:="pw", UserInterfaceOnly:=True
WSOsz.Protect Password:="pw", UserInterfaceOnly:=True
'értékadások
Set WSBev = Sheets("bevitel")
Set WSOsz = Sheets("ÖSSZESÍTÉS")
Bsor = WSOsz.Range("B" & Rows.Count).End(xlUp).Row + 1
usor = WSBev.Range("D2").End(xlDown).Row
'szűrés OK-ra
WSBev.ListObjects("bevitel").Range.AutoFilter Field:=17, Criteria1:="=OK"
'másolás és érték beillesztés
WSBev.Range("D2:T" & usor).Copy
WSOsz.Range("C" & Bsor).PasteSpecial xlPasteValues
'képlet, majd érték beillesztés a B oszlopba
Csor = WSOsz.Range("C" & Rows.Count).End(xlUp).Row
WSOsz.Range("B" & Bsor & ":B" & Csor) = "=B" & Bsor - 1 & "+1"
WSOsz.Columns(2).Copy
WSOsz.Range("B1").PasteSpecial xlPasteValues
'T2:W2 képlete az új sorokba az Összesítés lapon
WSOsz.Range("T2:W2").Copy
WSOsz.Range("T" & Bsor & ":W" & Csor).PasteSpecial xlPasteFormulas
Application.CutCopyMode = False 'kijelölés megszüntetése
With WSOsz.Range("B1").CurrentRegion 'keretezés
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
End With
WSBev.ListObjects("bevitel").Range.AutoFilter Field:=17 'OK-ra szűrés megszüntetése
WSBev.Range("D2:E200,G2:G200,H2:I200,B1:B6").ClearContents 'törlés
'új jelszó a bevitel laphoz
WSBev.Protect Password:="LiliLufi140127", UserInterfaceOnly:=True, _
AllowFiltering:=True, AllowFormattingColumns:=True
End SubProgramozó: 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 logitechh #37539 üzenetére
Sok helyen használod a Select utasítást, amik lassítják a program futását. Pl. a
Range("D2:T" & usor).Select
Selection.Copysorok helyett elég a
Sheets("bevitel").Range("D2:T" & usor).Copy
Ha itt nem értéket, hanem teljes tartományt kellene beilleszteni, ugyanebben a sorban megadhatod a célt is.
Sheets("bevitel").Range("D2:T" & usor).Copy Sheets("ÖSSZESÍTÉS").Range("C" & Bsor)
Azt már írtam Tgumis-nak is, hogy a
Lapneve.Protect Password:="pw", UserInterfaceOnly:=True
sor a makró részére írhatóvá teszi a lapot, nem kell külön a makró elején feloldani, majd a végén újra levédeni.
Msgbox a folytatáshoz:
Sub Kerdes()
Dim valasz
valasz = MsgBox("Futtassam a Másik makrót?", vbYesNo + vbQuestion, "Futtatási kérdés")
If valasz = vbYes Then Masik_Makro ' itt hívjuk meg a feladat végrehajtó makróját
End SubSub Masik_Makro()
MsgBox "Ez itt a Másik makró"
End Sub[ 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.
-
tgumis
tag
válasz Delila_1 #37540 üzenetére
Szia
Köszi logitechh és Delila_1
A logitechh verziója müxik viszont Delilia a tiédnél valamiért már az elején hibát dob:
Mikor okoz észrevehető lassulást a logitechh által készített verzió?
Mert - félre ne értsd logitechh - inkább a Delila_ verzióját preferálnám ha nagyon lassít. Már csak attól a hiba üzenettől kellene megszabadulni vhogy.
Amúgy közveb kisérletezgettem a msg boxal és sikerült nekem is kitalálni egyfajta megoldást. Persze gondolom ennél jóval egyszerűbb a Delila megoldása( de ő profi míg én lelkes amatőr lennék)
Íme:Sub message_box_szur_masol_beilleszt_()
Dim Answer As String
Dim MyNote As String
'itt adod meg a kérdést
'Place your text here
MyNote = "Rögzíted az adatokat?"
'itt adod meg a msg box címét
Answer = MsgBox(MyNote, vbQuestion + vbYesNo, "Rögzítés")
If Answer = vbNo Then
'Code for No button Press
MsgBox "Az adatok nem lesznek áttöltve az ÖSSZESÍTÉS munkalapra!"
Else
'Code for Yes button Press
MsgBox "Az adatok áttöltéser kerülnek az ÖSSZESÍTÉS munkalapra viszont nem kerülnek törlésre a BEVITEL munkalapról!" & _
vbCrLf & "A folyamat nem visszavonható!!!!!!" '&vbCrLf & ez a sortörést jelzi
' bevitel munkalapon kijelöl másol összesítés munkalapon szűrés alapra álítása
' mindkét munkalapon jelszavas védelem feloldás másolás munkalapon a másolás utána jelszavas védelem beállítása
'
' kezdet
'
' bevitel munkalap védettség feloldás
Sheets("bevitel").Unprotect Password:="pw1234"
' összesítés munkalap védettség feloldás
Sheets("összesítés").Unprotect Password:="pw1234"
' összesítés munkalapon az 2.sorban a szűrés kikapcsolása majd bekapcsolása
' azért így van megoldva mert ha le van szűrve akkor minden sort megjelenít
' ugyanis nem tudni előre milyen szűrés volt alkalmazva az összesítés munkalapon
Sheets("összesítés").Select
Rows("1:1").Select
Selection.AutoFilter
Selection.AutoFilter
' szűrés a bevitel munkalapon a 17. oszlopban
Sheets("bevitel").Select
Sheets("bevitel").Range("D2").Activate
Sheets("bevitel").ListObjects("bevitel").Range.AutoFilter Field:=17, Criteria1:="=OK", Operator:=xlAnd
usor = Range("D2").End(xlDown).Row
' bevitel munkalap védetté tétele
Sheets("bevitel").Protect Password:="pw1234", UserInterfaceOnly:=True, AllowFiltering:=True, AllowFormattingColumns:=True
' másolás
Range("D2:T" & usor).Select
Selection.Copy
'összesítés munkalap kijelölése
Sheets("összesítés").Select
Dim Asor As Long
Dim Bsor As Long
Dim i As Integer
' A oszloputolsó adat megkeresése majd a következő sor B oszlop elemét jelelöli ki
Asor = Range("A" & Rows.Count).End(xlUp).Row + 1
Range("B" & Asor).PasteSpecial xlPasteValues
Bsor = Range("B" & Rows.Count).End(xlUp).Row + 1
' S3:V3 tartományban található képletek másolása és beillesztés a következő sorba
Range("S2:V2").Copy Destination:=Range("S" & Asor & ":S" & Bsor - 1)
For i = Asor To Bsor - 1
Range("A" & i) = Range("A" & i - 1) + 1
Next i
With Range("A1").CurrentRegion
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
End With
Sheets("összesítés").Protect Password:="pw1234", UserInterfaceOnly:=True, AllowFiltering:=True, AllowFormattingColumns:=True
Sheets("bevitel").Select
Sheets("bevitel").ListObjects("bevitel").Range.AutoFilter Field:=17
End If
End SubEz a logitechh makrójára épül mert akkor még nem láttam Delila_1 megoldását.
-
Delila_1
Topikgazda
válasz tgumis #37542 üzenetére
A hiba azért lépett fel – amire korábban felhívtam a figyelmedet –, mert a makró végén a bevitel lap jelszavát módosítottuk pw-ről LiliLufi140127-re. Ha továbbra is meg akarod hagyni a pw-t, akkor az utolsó utasítást egyszerűen töröld ki a makróból.
Ezt kell kihagynod.
WSBev.Protect Password:="LiliLufi140127", UserInterfaceOnly:=True, _
AllowFiltering:=True, AllowFormattingColumns:=TrueÚgy tűnik, hiába írtam le már többször, hogy a
WSBev.Protect Password:="pw", UserInterfaceOnly:=True
WSOsz.Protect Password:="pw", UserInterfaceOnly:=Truesorok a 2 lapot a makró számára írhatóvá teszik, nem kell külön a makró elején felszabadítani, a végén pedig védetté tenni a lapokat.
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 tgumis #37544 üzenetére
Ha marad az elején beállított érték (pw, vagy pw1234, vagy bármi más), akkor a makró végi utolsó utasítás nem kell.
A hosszú jelszót valószínűleg elgépelted, nálam működik.
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
tgumis
tag
válasz Delila_1 #37546 üzenetére
Nos én nagyon béna vagyok
a munkafüzet minden lapját levédtem
jelszónak pw adtam meg és ugyanaz a hiba jön
Ne haragudj az értetlenségem miatt de már nincs ötletem.Sub Szur_Masol_Torol___()
Dim usor As Long, WSBev As Worksheet, WSOsz As Worksheet
Dim Bsor As Long, Csor As Long, valasz
valasz = MsgBox("Áttölthetem az adatokat?", vbYesNo + vbQuestion, "Választás")
If valasz = vbNo Then Exit Sub
'lapok védelmének feloldása a makró számára
WSBev.Protect Password:="pw", UserInterfaceOnly:=True
WSOsz.Protect Password:="pw", UserInterfaceOnly:=True
'értékadások
Set WSBev = Sheets("bevitel")
Set WSOsz = Sheets("ÖSSZESÍTÉS")
Bsor = WSOsz.Range("B" & Rows.Count).End(xlUp).Row + 1
usor = WSBev.Range("D2").End(xlDown).Row
'szűrés OK-ra
WSBev.ListObjects("bevitel").Range.AutoFilter Field:=17, Criteria1:="=OK"
'másolás és érték beillesztés
WSBev.Range("D2:T" & usor).Copy
WSOsz.Range("C" & Bsor).PasteSpecial xlPasteValues
'képlet, majd érték beillesztés a B oszlopba
Csor = WSOsz.Range("C" & Rows.Count).End(xlUp).Row
WSOsz.Range("B" & Bsor & ":B" & Csor) = "=B" & Bsor - 1 & "+1"
WSOsz.Columns(2).Copy
WSOsz.Range("B1").PasteSpecial xlPasteValues
'T2:W2 képlete az új sorokba az Összesítés lapon
WSOsz.Range("T2:W2").Copy
WSOsz.Range("T" & Bsor & ":W" & Csor).PasteSpecial xlPasteFormulas
Application.CutCopyMode = False 'kijelölés megszüntetése
With WSOsz.Range("B1").CurrentRegion 'keretezés
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
End With
WSBev.ListObjects("bevitel").Range.AutoFilter Field:=17 'OK-ra szűrés megszüntetése
WSBev.Range("D2:E200,G2:G200,H2:I200,B1:B6").ClearContents 'törlés
End Sub -
Delila_1
Topikgazda
válasz tgumis #37547 üzenetére
A védelmet az értékadások alá tedd!
'értékadások
Set WSBev = Sheets("bevitel")
Set WSOsz = Sheets("ÖSSZESÍTÉS")
Bsor = WSOsz.Range("B" & Rows.Count).End(xlUp).Row + 1
usor = WSBev.Range("D2").End(xlDown).Row
'lapok védelmének feloldása a makró számára
WSBev.Protect Password:="pw", UserInterfaceOnly:=True
WSOsz.Protect Password:="pw", UserInterfaceOnly:=True[ 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.
-
tgumis
tag
válasz Delila_1 #37549 üzenetére
Nagyon zsír
Már csak az a probléma (és természetesen ezt sem sikerül megfejtenem) hogy az összesítés munkalapon az A oszlopban nem sorszámozás történik hanem a b oszlop lemásolása és beillesztése
pedig ezzel kísérleteztem:Application.CutCopyMode = False 'kijelölés megszüntetése
'talán ez a sorszámozás
Range("S2:V2").Copy Destination:=Range("S" & Asor & ":S" & Bsor - 1)
For i = Asor To Bsor - 1
Range("A" & i) = Range("A" & i - 1) + 1
Next i
'talán itt a sorszámozás vége
de nem jártam iskerrel
Persze a jelszavazás jó helyre helyezés után nagyon jól müxik