-
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
-
poffsoft
addikt
válasz logitechh #35027 üzenetére
Ha már egyszer megtaláltad az utolsó sort, minden adatod meglesz:
Cells(usor, 1)=cells(usor-1, 1)+1
Az irányított beillesztéshez a cells(usor, 2).select kell, utána jöhet a makrórógzítőből a pastespecial.
A táblázatod pl. a range(cells(2, 1), cells(usor, 12)) lesz...[ Szerkesztve ]
[ Szerkesztve ]
-
poffsoft
addikt
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[ Szerkesztve ]
[ Szerkesztve ]
-
Delila_1
Topikgazda
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.Select
Mé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.
[ 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.
-
poffsoft
addikt
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[ Szerkesztve ]
[ Szerkesztve ]
-
Delila_1
Topikgazda
válasz logitechh #35035 üzenetére
Itt válaszoltam, közel 1 órával a hozzászólásod előtt.
Melyik területre illesztesz be "oszlopokat", és ezt hogy érted? Pl. a B12:M20 tartományba? A sorszámok ekkor az A12:A20 tartományba kellenek, folytatva az A11 értékétől?
Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
poffsoft
addikt
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...
[ Szerkesztve ]
[ Szerkesztve ]
-
Delila_1
Topikgazda
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 WithProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
poffsoft
addikt
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[ Szerkesztve ]
-
-
-
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.
-
Fferi50
őstag
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.
[ Szerkesztve ]
-
Mutt
aktív 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.Egy másik megoldás pedig képletekkel:
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
A tanácsaimat ingyen adom. Ha nem tetszik, akkor kérlek ne kritizáld! / https://github.com/viszi/codes/tree/master/Excel
-
Delila_1
Topikgazda
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 SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
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.
[ Szerkesztve ]
-
Fferi50
őstag
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.
-
Fferi50
őstag
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.
-
Delila_1
Topikgazda
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.
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 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 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 #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.
[ 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.
-
Delila_1
Topikgazda
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 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 #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 SubProgramozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.
-
sztanozs
veterán
válasz logitechh #42345 üzenetére
Amúgy a copy-paste-et felejteném, hacsak nem kell formátumot is másolni.
Amennyiben csak adatokat kell, akkorRangeCélCelák.Value2 = RangeForrásCellák.Value2
Csak annyi a feltétel, hogy a forrás és célcelláknak azonos méretűeknek kell legyenek.JOGI NYILATKOZAT: A bejegyzéseim és hozzászólásaim a személyes véleményemet tükrözik; ezek nem tekinthetők a munkáltatóm hivatalos állásfoglalásának...
-
Delila_1
Topikgazda
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.
[ 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.
Új hozzászólás Aktív témák
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: Ozeki Kft.
Város: Debrecen