- Magisk
- One mobilszolgáltatások
- iPhone topik
- Íme az új Android Auto!
- Samsung Galaxy S24 Ultra - ha működik, ne változtass!
- Szívós, szép és kitartó az új OnePlus óra
- Samsung Galaxy Fit 3 - keveset, de jól
- Honor Magic6 Pro - kör közepén számok
- Samsung Galaxy S23 és S23+ - ami belül van, az számít igazán
- Nothing Phone (3a) és (3a) Pro - az ügyes meg sasszemű
-
Mobilarena
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
-
tgumis
tag
válasz
logitechh
#48243
üzenetére
Hali
Én összeraktam egyet. Egy régebbi txt t létrehozó makróból:Sub MegrendeloMunkalapMenteseMaskent()
Const sLJNév As String = "Megrendelő"
Dim sPath As String: sPath = ThisWorkbook.Path & "\"
Dim sFNév As String 'név helyének lefoglalása
Dim sNytsz As String 'OK kell
Dim sSzallito As String
Dim sDatum As String
Dim sUser As String
sNytsz = Worksheets("Megrendelő").Range("X1") 'név deklarálása
sSzallito = Worksheets("Megrendelő").Range("C8")
sDatum = Worksheets("Megrendelő").Range("C12")
sUser = Worksheets("Megrendelő").Range("X2")
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets(sLJNév)
sFNév = "M_" & sNytsz & "_" & sSzallito & "_" & sDatum & "_" & sUser & "_" & Format(Now, "yyyymmddhhnnss") & ".xlsx"
.Copy
End With
With ActiveWorkbook
.SaveAs Filename:=sPath & sFNév, FileFormat:=xlWorkbookDefault, CreateBackup:=False
.Close SaveChanges:=False
End With
Application.ScreenUpdating = True
Range("A1").Select
End Sub -
Pakliman
tag
válasz
logitechh
#46565
üzenetére
Szia!
Mindkét exportos eljárásban az éppen aktív MUNKAFÜZETET NEVEZED ÁT (ActiveWorkbook.SaveAs)!
Mellékszál:
Sokszor hajtatod végre vele ugyanazokat a műveleteket.
Ezeket kiküszöbölheted egy egyszeri értékadással:sNewNamePart1 = ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "_Dezsike_"A cntr használatának nem látom semmiféle értelmét, hiszen a fájlnévben nem sorszámozást vagy darabszámot használsz, hanem pontos időt (persze lehet ebből is több, ha másodpercenként többször is lefut a program!!)
Ez egy lehetőség (ha kell, át tudod alakítani xls exportra is):
Sub ActiveSheetExportToTXT()
Dim sNewName As String 'A létrehozandó fájl neve
Dim sSheetName As String 'A mentendő munkalap neve
Dim sSheetFIX As String 'A FIX cellát tartalmazó munkalap neve
'Névnek a munkalap nevét és egy FIX cellából vett értéket szeretném plusz az aktuális dátum időpont másodpercre pontosan.
sSheetFIX = "A FIX cellát tartalmazó munkalap neve"
sSheetName = "A mentendő Munkalap neve"
sNewName = ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "_Dezsike_" & Worksheets(sSheetFIX).Range("FIX cella") & "_" & Format(Now, "yyyymmdd_hhnn_ss") & ".txt"
Worksheets(sSheetName).Copy
ActiveWorkbook.SaveAs Filename:=sNewName, FileFormat:=xlText, CreateBackup:=False
End Sub -
logitechh
csendes tag
válasz
logitechh
#46561
üzenetére
Sziasztok!
Összetákoltam valait de sajnos valami nem ok.
Össze vissza megismétli a nevet és nem mindig abba a mappába ment ahová kellene hanem egyel kijjebb majd ismét egy mappával kijjebb
Esetleg valaki tudja hol ronthattam el?Sub AutomatikusMentes()
ActiveSheetExportToTXT
MunkalapAtnevez
ActiveSheetExportToXLSM
End Sub
Sub MunkalapAtnevez()
Dim strMunkalapNev As String 'hely foglalás a memóriában
strMunkalapNev = "létszámjelentő" 'név deklarálása
ActiveSheet.Select 'aktív munkalap kijelölése
ActiveSheet.Name = strMunkalapNev 'aktív munkalap neének megadása a deklarált név alapján
End Sub
Sub ActiveSheetExportToTXT()
'aktív munkalap lementése a név:a munkafüzet neve_létszám_dátum_óra perc_másodperc
cntr = ""
If Dir(ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "_Dezsike_" & cntr & ".txt") = "" Then GoTo xprt
If Dir(ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "_Dezsike_" & cntr & ".txt") <> "" Then
cntr = 1
Do Until Dir(ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "_Dezsike_" & cntr & ".txt") = ""
cntr = cntr + 1
Loop
End If
xprt:
ActiveWorkbook.SaveAs filename:= _
ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "_Dezsike_" & Format(Now, "yyyymmdd_hhnn_ss") & ".txt", _
FileFormat:=xlText, _
CreateBackup:=False
End Sub
Sub ActiveSheetExportToXLSM()
'aktív munkalap lementése a név:a munkafüzet neve_létszám_dátum_óra perc_másodperc
cntr = ""
If Dir(ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "Létszámjelentő" & cntr & ".xlsm") = "" Then GoTo xprt
If Dir(ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "Létszámjelentő" & cntr & ".xlsm") <> "" Then
cntr = 1
Do Until Dir(ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "Létszámjelentő" & cntr & ".xlsm") = ""
cntr = cntr + 1
Loop
End If
xprt:
ActiveWorkbook.SaveAs filename:= _
ThisWorkbook.Path & "\" & Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & "Létszámjelentő" & Format(Now, "yyyymmdd_hhnn_ss") & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub -
Fferi50
Topikgazda
-
Fferi50
Topikgazda
válasz
logitechh
#44697
üzenetére
Szia!
"az 1 el való szorzàs miért kell a képletbe?"
Csak az utolsó képletbe kell, mert ott az IGAZ-HAMIS értékeket nem tudja másképp számként értelmezni a SZORZATÖSSZEG függvény, mivel ott nem lenne más művelet a képlet tényezői között.
Az Excelben az IGAZ-HAMIS logikai függvények értéke számként is használható a számítási műveletekben: IGAZ értéke 1-re, HAMIS értéke 0-ra értékelődik. Az első két képletben szorzási művelet van a tényezők között, így automatikusan számként értelmezi a logikai értékeket is az Excel.Üdv.
-
Fferi50
Topikgazda
válasz
logitechh
#44694
üzenetére
Szia!
Egy szép tömbképlet segít ebben:
I11 cella képlete:=SZUM(($F$2:$F$9=$A11)*I$2:I$9*$D$2:D$9)
A képletet Ctrl+Shift+Enterrel kell bevinni a cellába. Az Excel kapcsos zárójelbe teszi.
Ezután húzhatod lefelé és oldalra is.
De ha nem szereted a tömbképleteket, akkor ez nem az:=SZORZATÖSSZEG(($F$2:$F$9=$A11)*I$2:I$9*$D$2:D$9)
Ez is húzható.
Vagy=SZORZATÖSSZEG(($F$2:$F$9=$A11)*1;I$2:I$9;$D$2:D$9)
Szintén húzható képlet.
Üdv. -
-
Delila_1
veterán
válasz
logitechh
#42365
üzenetére
Az eredeti füzetek nevét beírod a Célfüzet.xlsm Céllap T oszlopába T1-től T15-ig, kiterjesztéssel együtt. Ebbe a füzetbe másold be modulba a Beilleszt makrót. Tehetsz ki hozzá egy gombot.
A makró abban a sorrendben, ahogy a T oszlopba beírtad a neveket, megnyitja az eredeti fájlokat, majd bemásolja belőlük a Célfüzet megfelelő helyére az A1:M12 tartományt. A megnyitott füzeteket mentés nélkül bezárja.Sub Beilleszt()
Dim usor As Integer, fuzet As Integer, utvonal As String, FN As String
utvonal = "F:\Eadat\Excel fórumok\PH\" 'Ezt írd át!
ActiveSheet.Protect Password:="Jelszo01", UserInterfaceOnly:=True
For fuzet = 1 To 15
FN = Cells(fuzet, "T")
On Error Resume Next
Workbooks.Open Filename:=utvonal & FN
Workbooks("Célfüzet.xlsm").Activate
Sheets("Céllap").Activate
usor = Range("A" & Rows.Count).End(xlUp).Row
If usor > 1 Then usor = usor + 3
Range("A" & usor & ":M" & usor + 11).Value = Workbooks(FN).Sheets("Munka1").Range("A1:M12").Value
Workbooks(FN).Close False
Next
Application.CutCopyMode = False
End SubA Torol makróid szerepét nem látom át. Nem tudom, melyik füzetben torlik az adatokat.
-
-
Delila_1
veterán
válasz
logitechh
#42348
üzenetére
Két füzeted van: Eredeti.xlsm és Célfüzet.xlsm. Az utóbbiban van a Céllap.
Mindkét füzetben modulba kell tenned a makrót.Eredeti.xlsm-be a Másolás gombhoz rendelve:
Sub Masolas()
Dim utvonal As String
utvonal = "F:\Eadat\Excel fórumok\PH" 'Ezt írd át!
Range("C2:O13").Copy
' Selection.Copy 'A kijelölt területet másolja
On Error Resume Next 'Ha nincs nyitva a Célfüzet
Workbooks.Open Filename:=utvonal & "\Célfüzet.xlsm"
Workbooks("Célfüzet.xlsm").Activate
Sheets("Céllap").Activate
End SubCélfüzet.xlsm-be a Beillesztés gombhoz rendelve:
Sub Beilleszt()
Selection.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub -
Delila_1
veterán
válasz
logitechh
#42343
üzenetére
Ha másik füzetbe akarsz másolni, akkor a célfüzet céllapján kell feloldanod a lapvédelmet a makró számára.
Sub Masol_Beilleszt()
Workbooks("Célfüzet.xlsx").Sheets("Céllap").Protect Password:="Jelszo01", UserInterfaceOnly:=True
Range("C2:O13").Copy 'a másolandó lapról indulsz
Workbooks("Célfüzet.xlsx").Sheets("Céllap").Range("C15").PasteSpecial xlPasteValues
End Sub -
Delila_1
veterán
válasz
logitechh
#42339
üzenetére
Elég 1 makró, ami másol és beilleszt. Ha nem volt jelszóval védve a lap, a másolás után akkor is védve lesz.
Sub Masol_Beilleszt()
ActiveSheet.Protect Password:="Jelszo01", UserInterfaceOnly:=True
Sheets("Munka1").Range("C2:O13").Copy
Range("C15").PasteSpecial xlPasteValues
End SubSztanozs: a UserInterfaceOnly:=True a makró részére (és csakis a makró részére) engedélyezi a beillesztést a védett lap zárolt celláiba.
-
-
Delila_1
veterán
válasz
logitechh
#41115
üzenetére
Arra van a példa, hogy minden adatot az első üres sorba rögzíts (usor változó). Ha mindig ugyanabba a cellába akarod rögzíteni, akkor a
'Felírás a Munka1 lapra
usor = Sheets("Munka1").Range("A" & Rows.Count).End(xlUp).Row + 1
For oszlop = 1 To 5
Sheets("Munka1").Cells(usor, oszlop) = Controls("ComboBox" & oszlop)
Controls("ComboBox" & oszlop) = ""
Next
Sheets("Munka1").Cells(usor, 6) = TextBox1
TextBox1 = ""részt kell átírnod. Nincs szükség az usor-ra, hanem fixen add meg.
'Felírás a Munka1 lapra
For oszlop = 1 To 5
Sheets("Munka1").Cells(2, oszlop) = Controls("ComboBox" & oszlop)
Controls("ComboBox" & oszlop) = ""
Next
Sheets("Munka1").Cells(2, 6) = TextBox1
TextBox1 = ""Így az adtok a 2. sorba kerülnek, a címsor alá.
Megadhatod a felírást a ComboBox change eseményében is:
Private Sub ComboBox1_Change()
Sheets("Munka1").Cells(2, 1) = ComboBox1 'A2 cella
ComboBox1 = "" 'ComboBox1 üresre állítása
End Sub -
Delila_1
veterán
válasz
logitechh
#41098
üzenetére
Eleve Combobox legyen a formon. Ennek a RowSource paraméterénél megadod a választható adatok helyét, pl. Törzsadatok!A1:A15. Kiválasztáskor a
Private Sub ComboBox1_Change()
Sheets(1).Range("EL5") = ComboBox1
End Submakró beírja az értéket az első lap EL5 cellájába. Nyomógombhoz is rendelheted a makrót a ComboBox helyett.
-
Fferi50
Topikgazda
válasz
logitechh
#41070
üzenetére
Szia!
Nem vagyok nagy híve a formázott adatok közötti sor/oszlop törlésnek, ha máshogyan is meg lehet csinálni.
Pl. úgy, hogy rámásolod a mögötte levő sorok tartalmát, majd az utolsó sor tartalmát törlöd.
Valahogy így:Dim sor As Integer
sor=Range("J12").Value
Range(Cells(sor+1 ,"A"),Cells(109,"H")).Copy Destination:=Cells(sor,"A")
Range(Cells(109,"A"),Cells(109,"H")).ClearContentsÍgy nem rontod el az adataid és nem marad köztük üres sor sem.
Üdv.
-
Fferi50
Topikgazda
válasz
logitechh
#41067
üzenetére
Szia!
Nem kell törölni a sort, majd újra beszúrni.
Elég a ClearContents tulajdonságot használni:Range("A100:H100").ClearContents.
Ha az A1 cellában van a sor száma:Range("A" & Cells(1,1).Value & ":H" & Cells(1,1)).ClearContents
A tartalom törlődik és a sor marad, újra felhasználható.Üdv.
-
ny.janos
tag
válasz
logitechh
#41064
üzenetére
Szia!
A sorszámozandó oszlop 2. sorának képlete, ha a hivatkozott oszlop (a képletben B) kizárólag számokat tartalmaz:
=ÖSSZESÍT(2;5;$B$2:B2)
Ha a hivatkozott oszlopban nem csak számok vannak:=ÖSSZESÍT(3;5;$B$2:B2)Működési korlát, hogy a hivatkozott oszlop (a példámban B) minden sorának kell adatot tartalmaznia. Ha ez nem teljesül, akkor a képlet sajnos nem alkalmazható. Ebben az esetben marad a makró, amit Delila_1 írt.
-
Delila_1
veterán
válasz
logitechh
#41064
üzenetére
Makró arra az esetre, ha a szűrt oszlop az A, a sorszámot pedig a B oszlopba kell írni.
Sub Sorszamozas()
Dim sor As Long, usor As Long, sorszam As Long
usor = Range("A" & Rows.Count).End(xlUp).Row
sorszam = 1
For sor = 2 To usor
If Rows(sor).Hidden = False Then
Range("B" & sor) = sorszam
sorszam = sorszam + 1
End If
Next
End Sub -
-
Mutt
senior tag
válasz
logitechh
#37898
üzenetére
Szia,
A legegyszerübb megoldás egy Kimutatás (Pivot) készítése az adatsorra.
Az egyik kimutatás összeszedné az ételeket, a másik pedig az összetevőket.pl.
Egy másik megoldás pedig képletekkel:
pl.
Az eredeti adatsort táblázattá konvertáltam (neve Receptek) az egyszerűség kedvéért.
Az A2-ben ez a tömbképlet (Ctrl+Shift+Enter-t kell nyomni a bevitel után):=HAHIBA(INDEX(Receptek[kód];HOL.VAN(0;DARABTELI($A$1:$A1;Receptek[kód]);0));"")A B2 már egy egyszerű FKERES:
=HA(A2<>"";FKERES(A2;Receptek;2;0);"")A C2 lehet egy SZUMHA, de én SZORAZTÖSSZEG-et használtam,
=SZORZATÖSSZEG(--(Receptek[kód]=A2)*(Receptek[mennyiség]*Receptek[nyilvántartási ár]/Receptek[Egység tömeg]))A másik táblázatban a recept megnevezését egy listából lehet választani.
F3-ban egy hosszú képlet van:=HA(DARABTELI(Receptek[Recept megnevezés];$G$1)>=SOROK($F$3:F3);INDEX(Receptek[[#Mind];[összetevő]];ÖSSZESÍT(15;6;SOR(Receptek[Recept megnevezés])/(Receptek[Recept megnevezés]=$G$1);SOROK($F$3:F3)));"")G3-ban a fentivel megegyező a képlet, csak nem az összetevőt hanem a mennyiségét iratjuk ki az INDEX segítségével:
=HA(DARABTELI(Receptek[Recept megnevezés];$G$1)>=SOROK($F$3:F3);INDEX(Receptek[[#Mind];[mennyiség]];ÖSSZESÍT(15;6;SOR(Receptek[Recept megnevezés])/(Receptek[Recept megnevezés]=$G$1);SOROK($F$3:F3)));"")üdv
-
Fferi50
Topikgazda
válasz
logitechh
#37792
üzenetére
Szia!
Számolást kikapcsolod. (Képletek - Számolási beállítások - Manuális). Ezután Ctrl+F (keresés és csere), Keresett szöveg 10403 Csere fül -- Csere erre: amire akarod, majd Egyebekre katt, Keresés helye kiválasztod Képletek --- az összes cseréje.
Számolás visszakapcsolása (Képletek - Számolási beállítások - Automatikus)
Makróval:
Application.Calculation=xlCalculationManual
Activesheet.Usedrange:Find What:="10403",LookIn:=xlFormulas,LookAt:=xlPart
Activesheet.Usedrange.Replace What:="10403", Replacement:="5000",LookAt:=xlpart
Application.Calculation=xlCalculationAutomaticÜdv.
-
Delila_1
veterán
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).CopyHa 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:=Truesor 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 -
poffsoft
veterán
válasz
logitechh
#35063
üzenetére
Sub beillesztes()
'
' előre másik munkalapból kimásolt 4 oszlop szélességü tartományt beilleszt a B oszlop első üres sorától kezdve a B oszloptól az E oszlopig majd az A oszlopot kitölti sorszámmal illetve az F oszloptól az L oszlopig az F2:L2 tartomány képleteit másolja be addig a sorig ameddig a B oszlop tartalmaz elemet
'
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
Range("F2:L2").Copy Destination:=Range("F" & Asor & ":F" & Bsor ) 'a végén a -1 azt jelzi hogy nem az utlsó kitöltött sor plusz egy sorba másolja a képletet hanem csak az utolsó sorig
For i = Asor To Bsor 'számláló rész a Bsor esetén plusz egy sort beszámoz viszont ha csak a kitöltött celláig akarunk számozni akkor a-1 kell
Range("A" & i) = Range("A" & i - 1) + 1
Next i
'innen kezdődik a keretezés
With Range("A1").CurrentRegion
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
End With
End Sub -
Delila_1
veterán
válasz
logitechh
#35046
üzenetére
A keretezéshez célszerűbb ez a rövid változat. Az Around egyszerre határozza meg a bal, jobb, alsó és felső keret paramétereit.
With Range("A1").CurrentRegion
.BorderAround LineStyle:=xlContinuous, Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
End With -
poffsoft
veterán
válasz
logitechh
#35039
üzenetére
egyszerűbb lett volna az elején elmondanod, mik vannak.
Sub mm()
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("F2:L2").Copy destination:=Range("F" & Asor &":F" & Bsor)
For i = Asor To Bsor
Range("A" & i) = Range("A" & i - 1) + 1
Next i
End SubSzerintem a rangod miatt nem enged válaszolni...
-
-
poffsoft
veterán
válasz
logitechh
#35035
üzenetére
Azt nem mondtad, hogy több sor is.
Sub mm()
Dim usor As Long
Dim i As Integer
usor = Range("B" & Rows.Count).End(xlUp).Row + 1
'ide jön a "4 oszlopnyi adat" másolása, például
'range("B" & usor-1 & ":E" & usor-1).copy
'Fontos, hogy az irányított beillesztés előtt legyen Copy parancs
Range("B" & usor).PasteSpecial xlPasteValues
For i = Range("A" & Rows.Count).End(xlUp).Row to Range("B" & Rows.Count).End(xlUp).Row
Range("A" & i) = Range("A" & i - 1) + 1
Next i
End Sub -
Delila_1
veterán
válasz
logitechh
#35027
üzenetére
Sub mm()
Dim usor As Long
usor = Range("B" & Rows.Count).End(xlUp).Row + 1
'ide jön a "4 oszlopnyi adat" másolása, például
'range("B" & usor-1 & ":E" & usor-1).copy
'Fontos, hogy az irányított beillesztés előtt legyen Copy parancs
Range("B" & usor).PasteSpecial xlPasteValues
usor = Range("A" & Rows.Count).End(xlUp).Row + 1
Range("A" & usor) = Range("A" & usor - 1) + 1
End SubA keretezéshez a tartomány kijelölése
Range("A1").CurrentRegion.SelectMég a select sem szükséges.
With Range("A1").CurrentRegion
.BorderAround LineStyle:=xlContinuous, Weight:=xlMedium
.Borders(xlInsideVertical).Weight = xlThin
.Borders(xlInsideHorizontal).Weight = xlThin
End WithEz a makró körbe vastagabb, belül véknyabb szegélyt ad a tartományodnak.
-
poffsoft
veterán
válasz
logitechh
#35029
üzenetére
Sub iranyitott_beillesztes()
'
' iranyitott_beillesztes_ Makró
'
'
Dim usor As Long
usor = Range("A" & Rows.Count).End(xlUp).Row +1
Cells(usor, 1)=Cells(usor-1, 1)+1
Cells(usor, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range(Cells(2, 1), Cells(usor, 12)).Select
'
' itt jöhet a szegélyezés
'
Cells(usor, 1).Select
End Sub -
poffsoft
veterán
Szívesen.
Új hozzászólás Aktív témák
Hirdetés
Fferi50- Milyen billentyűzetet vegyek?
- Magisk
- Dell notebook topic
- Fejhallgató erősítő és DAC topik
- exHWSW - Értünk mindenhez IS
- IGP nélküli processzorokkal készül az Intel és az AMD
- Trollok komolyan
- AMD Ryzen 9 / 7 / 5 9***(X) "Zen 5" (AM5)
- Épített vízhűtés (nem kompakt) topic
- One mobilszolgáltatások
- További aktív témák...
- Assassin's Creed Shadows Collector's Edition PC
- Adobe Előfizetések - Adobe Creative Cloud All Apps - 12 Hónap - NYÁRI AKCIÓ!
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Vírusirtó, Antivirus, VPN kulcsok
- BESZÁMÍTÁS! Microsoft XBOX One S 1TB lemezes játékkonzol garanciával hibátlan működéssel
- ÁRGARANCIA!Épített KomPhone Ryzen 7 5700X3D 32/64GB RAM RTX 5070 12GB GAMER PC termékbeszámítással
- Bomba ár! Dell Latitude E5570 Touch - i5-6300U I 8GB I 256SSD I 15,6" FHD I HDMI I CAM I W10 I Gari
- AKCIÓ! "ÚJ" Microsoft Surface 5 13,5 notebook - i5 1235U 8GB RAM 256GB SSD Intel Iris Xe IGP 27% áfa
- Samsung Galaxy Xcover 5 64GB, Kártyafüggetlen, 1 Év Garanciával
Állásajánlatok
Cég: PCMENTOR SZERVIZ KFT.
Város: Budapest
Cég: PC Trade Systems Kft.
Város: Szeged