-
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
-
Delila_1
Topikgazda
-
Delila_1
Topikgazda
válasz alfa20 #21112 üzenetére
Sub mm()
Select Case Cells(1) Mod 2
Case 0
Cells(1, 2) = "Páros"
Case Else
Cells(1, 2) = "Páratlan"
End Select
End SubA Mod 2 a maradékot adja cellának 2-vel történő osztásakor.
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
Lrow= ...(másik füzet lapján az első üres sor)
filterezés
terület kijelölése
selection.copy
Workbooks("Másikfüzet.xlsx").Sheets("AhovaMásolsz").range("A" & Lrow.).PasteSpecial xlPasteValuesHa nincsenek a táblázatban képletek, akkor elég így:
selection.copy Workbooks("Másikfüzet.xlsx").Sheets("AhovaMásolsz").range("A" & Lrow.)
Képleteknél inkább utólag add meg azokat az új füzetben, mert ha másolod, a hivatkozások az eredeti füzetre mutatnak majd.
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 pentium4 #21127 üzenetére
Az A1:A6 tartományba csak a "tól" értéket (0,1 ... 50,1) írd be, akkor az FKERES függvényt tudod alkalmazni.
A B8 cella képlete =HA(A8>=0,1;FKERES(A8;A1:B6;2;1);0)
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 detroitrw #21130 üzenetére
A képlet végére írj egy szorzást, ami számmá alakítja a függvénnyel leválasztott szöveg típusú részt. Természetesen a szorzó 1 legyen, hogy az érték ne változzon.
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 djembito #21137 üzenetére
A2 -> =BAL(B2;3)&C2
J2 -> =HA(DARAB2(D2:I2)>=5;SZUM(D2:I2)-MIN(D2:I2);"")
K2 -> =HA(DARAB2(D2:I2)<5;"nincs jegy";FKERES(J2;határok!$A$1:$B$5;2))
Itt a keresési tartományt át kell írnod a határok lap valós tartományára!Q5 -> =KEREKÍTÉS(ÁTLAGHATÖBB(K:K;C:C;"F";K:K;">3");1)
[ 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 *Frenszisz* #21141 üzenetére
A laphoz rendelt eseménykezelő csakis a saját lapján tud módosítani, de meghívhatsz vele egy nem eseménykezelő makrót.
Megoldás: a Munka2 laphoz rendelj eseménykezelőt, ami az A1 cella változása esetén meghív egy makrót, amivel a Munka1!A1-be beíratod hivatkozást.
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 *Frenszisz* #21141 üzenetére
Munka2 laphoz
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then Képlet Target 'átadjuk a változót
End SubModulba
Sub Képlet(Target) 'átvesszük a változót
Dim updating As Boolean
Sheets("Munka1").Range("A1") = Target
If updating Then Exit Sub
updating = True
If Sheets("Munka1").Range("A1") = 1 Then
Sheets("Munka1").Range("B1") = 500
Else: Sheets("Munka1").Range("B1") = ""
End If
updating = 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.
-
Delila_1
Topikgazda
válasz djembito #21143 üzenetére
Nem figyelsz! Az FKERES tartományát nem jól írod.
Nézd meg jobban a 21140-ben írt képletet.
Az is megeshet, hogy az adataid a határok lapon nem az A:B oszlopok tetején vannak.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
-
Delila_1
Topikgazda
válasz fogtunder #21161 üzenetére
A makróba írtam magyarázó kommenteket.
Sub Valami()
Dim usor As Long, oszlop As Integer
'alsó sor az A oszlopban
usor = Range("A" & Rows.Count).End(xlUp).Row
'első üres oszlop a 3. sorban
oszlop = Range("A3").End(xlToRight).Column + 1
'képlet az első üres oszlopba 3-tól usorig
Range(Cells(3, oszlop), Cells(usor, oszlop)) = _
"=IFERROR(VLOOKUP(A3,Stock_Movements_Coverage!A:AC,17,0),0)"
Columns(oszlop).Copy 'képletek másolása
'értékek irányított beillesztése
Cells(1, oszlop).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 fogtunder #21168 üzenetére
Cells-nél kötelező a sor, oszlop szintaktika. Ha a hangulatod szerint változtatnád, honnan tudná szegény VBA, hogy éppen mit értsen a megadott paramétereken?
A range-nél éppen fordítva, oszlop, sor a sorrend. Hogy miért így írták meg a fejlesztők, az rejtély előttem.
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 raynen #21205 üzenetére
Makróval gyorsan megy.
Nálam a másolandó lap a Munka1, ahova másolsz, Munka2. Ezeket írd át a makróban a saját lapjaid nevére.
Az előző adatok törlésénél az A:F helyett a saját törlendő oszlopaidat írd be.
Írtam megjegyzéseket a makróba.Sub Masol()
Dim sor As Long, usor As Long, ujsor As Long
'Előző adatok törlése a Munka2 lapon
Sheets("Munka2").Columns("A:F").Delete
Sheets("Munka1").Select
'Címsor másolása
Rows(1).Copy Sheets("Munka2").Range("A1")
'Alsó sor a másolandó lapon
usor = Application.CountA(Columns(1))
'Ebbe a sorba másoljon
ujsor = 2
'Minden 5. sor másolása
For sor = 2 To usor Step 5
Rows(sor).Copy Sheets("Munka2").Range("A" & ujsor)
ujsor = ujsor + 1
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.
-
Delila_1
Topikgazda
válasz Metathrone #21208 üzenetére
A gombok Click eseményében tudod állítani az engedélyezést.
gomb_neve.enabled=true, vagy gomb_neve.enabled=false.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
-
Delila_1
Topikgazda
válasz jaja1981 #21216 üzenetére
A laphoz kell rendelned a makrót.
A makró a H1 cella változására szűri, vagy nem az A oszlopot.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$H$1" Then
If Range("H1") > "" Then
Selection.AutoFilter Field:=1, Criteria1:=Range("H1")
Else
Selection.AutoFilter Field:=1
End If
End If
End SubBeírod a H1-be a keresett értéket, indul a szűrés. Ha kitörlöd a cella értékét, minden sorod látható lesz.
A Field:=1 határozza meg, hogy a tartományod első oszlopát akarod szűrni.
A saját igényeidhez a H1 és a Field értékei kell módosítanod.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 jaja1981 #21218 üzenetére
Nem kell a sok változó, a kritériumnál megadhatod a csillagokat.
A szűrt tartományt a Munka2 lap A1-be másolja.Sub Szur_Masol()
ActiveSheet.Range("$A$3:$N$15000").AutoFilter Field:=1, Criteria1:="*" & Range("I1") & "*"
Range("A3").Select
Selection.CurrentRegion.Copy Sheets("Munka2").Range("A1")
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 Metathrone #21220 üzenetére
Nem én írtam, és már nem emlékszem, honnan spájzoltam be. A füzet megnyitásakor az aktuális lap A1 cellájába írja az időt, és másodpercenként módosítja.
A ThisWorkbook-hoz rendeld:
Private Sub Workbook_Open()
Recalc
End SubModulba:
Dim SchedRecalc As Date
Sub Recalc()
Range("A1").Value = Format(Time, "hh:mm:ss")
Call SetTime
End Sub
Sub SetTime()
SchedRecalc = Now + TimeValue("00:00:01")
Application.OnTime SchedRecalc, "Recalc"
End Sub
Sub Disable()
On Error Resume Next
Application.OnTime EarliestTime:=SchedRecalc, Procedure:="Recalc", Schedule:=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.
-
Delila_1
Topikgazda
válasz Metathrone #21223 üzenetére
Tedd ki, hogy más is tudja hasznosítani.
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 Metathrone #21225 üzenetére
Mindegyik makró modulba kerül.
Private Leallitando As Boolean
Private Xlsnev As String
Private Munkalapnev As String
Private Cellasor As Integer
Private Cellaoszlop As Integer
Sub Pontosidő()
If Leallitando Then Exit Sub
Application.OnTime Now() + TimeSerial(0, 0, 1), "Pontosidő"
Workbooks(Xlsnev).Sheets(Munkalapnev).Cells(Cellasor, Cellaoszlop) = Format(Now(), "yyyy.mm.dd. hh:nn:ss")
End Sub
Sub leallítás()
Leallitando = True
End Sub
Sub Inditás()
Xlsnev = ActiveWorkbook.Name
Munkalapnev = ActiveSheet.Name
Cellasor = 1
Cellaoszlop = 1
Leallitando = False
Pontosidő
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 user112 #21232 üzenetére
Szia!
Bár kaptál már választ, adok egy makrós megoldást, ami 3-nál több változat esetén is működik.
A makró lényege, hogy az A oszlop adatait az F oszlopba másolja, majd ebből eltávolítja az ismétlődéseket.
Egy ciklusban az F mellé, az első üres oszlopba írja a hozzá tartozó B értéket.A makró végén ***-os sorok közé írt rész törli az eredeti A és B oszlop tartalmát, helyére írja a kigyűjtött adatokat, majd a kigyűjtött részt is törli. Ha erre nincs szükséged, töröld a makróból ezeket a sorokat.
Azért javasolom a makrós megoldást, mert az összetett képletekkel nem terheli a memóriát, és nem növeli a fájl méretét ezekkel.
Sub valami()
Dim sor As Long, usor As Long, ertek As String, jel As String
Dim sor1 As Long
usor = Range("A" & Rows.Count).End(xlUp).Row
'A oszlop adatainak másolása az F oszlopba
Range("A1:A" & usor).Copy Range("F1")
'Ismétlődések eltávolítása az F oszlopból
ActiveSheet.Range("$F$1:$F$" & usor).RemoveDuplicates Columns:=1, Header:=xlNo
For sor = 1 To usor
ertek = Cells(sor, "A")
jel = Cells(sor, "B")
sor1 = Application.WorksheetFunction.Match(ertek, Columns(6), 0)
Cells(sor1, Cells(sor1, Columns.Count).End(xlToLeft).Column + 1) = jel
Next
'**************************************************
Range("A1:B" & usor) = ""
Range("F1").Select
Selection.CurrentRegion.Copy Range("A1")
Range("F:Z") = ""
'**************************************************
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.
-
Delila_1
Topikgazda
válasz Gandalf80 #21244 üzenetére
C2 –> =HA(BAL($B2;3)="Be ";JOBB($B2;HOSSZ($B2)-3);"")
D2 –> =HA(BAL($B2;3)="Ki ";JOBB($B2;HOSSZ($B2)-3);"")
E2 –> =HA(HOSSZ(D2)>0;INDIREKT("A" & HOL.VAN(D2;D:D;0))-INDIREKT("A"&HOL.VAN(D2;C:C;0));"")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 Gandalf80 #21244 üzenetére
Előfordulhat, hogy a megkezdett műszakot másnap fejezi be valaki. Ennek megfelelően kibővítettem a táblázatot.
C és D oszlop képlete marad, ahogy volt,E2 –> =HA(HOSSZ(D2)=0;"";INDIREKT("A"&HOL.VAN(D2;C:C;0)))
F2 –> =HA(HOSSZ(D2)=0;"";INDIREKT("A"&HOL.VAN(D2;D:D;0)))G2 képlete látszik a képen.
Kissé valószínűtlenek az adatok, pl. az 502-es azonosítójú embernél.
[ 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 user112 #21248 üzenetére
A Munka1 lapon elvégzi a makró a kigyűjtést a K oszloptól kezdődően, majd a kigyűjtött tatrományt áthelyezi a Munka2 lap A2 cellájától kezdve. A Munka2 lap címsorát egyszer kell beírni.
A makróban többször szerepel a két lap neve, ezeket írd át a saját lapjaid nevére.
Sub valami()
Dim sor As Long, usor As Long, ertek As String, jel As String
Dim sor1 As Long
Sheets("Munka1").Select
usor = Range("A" & Rows.Count).End(xlUp).Row
'A oszlop adatainak másolása az K oszlopba
Range("A2:A" & usor).Copy Range("K1")
'Ismétlődések eltávolítása a K oszlopból
ActiveSheet.Range("$K$1:$K$" & usor - 1).RemoveDuplicates Columns:=1, Header:=xlNo
For sor = 2 To usor
ertek = Cells(sor, "A")
jel = Cells(sor, "F")
sor1 = Application.WorksheetFunction.Match(ertek, Columns(11), 0)
Cells(sor1, Cells(sor1, Columns.Count).End(xlToLeft).Column + 1) = jel
Next
'Munka2 lapon előző adatok törlése
Sheets("Munka2").Range("A2:Z5000") = ""
'Kigyűjtött adatok kivágása és másolása a Munka2 lap A2 cellájába
Range("K1").Select
Selection.CurrentRegion.Cut Sheets("Munka2").Range("A2")
Sheets("Munka2").Activate
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 benkez #21253 üzenetére
Az első kérdésedre (P oszlopba 1 dátum) írtam egy makrót, amit a lapodhoz kell rendelned.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 16 Then
Cells(Target.Row, Application.Match(Target, Rows(11), 0)).Activate
End If
End SubMiért OFFban írsz? Ide tartozik a kérdésed, a szürke karakterek rosszul olvashatóak.
A 11. sorban dátumok legyenek, a cellaformátum n.
A T10 cella képlete: =HÓNAP(T11)
[ 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 Esterka #21259 üzenetére
A makró beírja a kijelölt területre a nullákat, majd az egyeseket. Azt majd valaki kitalálja, hogyan legyen ebből véletlenszerű elrendezés.
Sub Nulla_Egy()
sorok = Selection.Rows.Count
oszlopok = Selection.Columns.Count
ter = sorok * oszlopok
egyDb = Round(ter / 100 * 12, 0)
nullaDb = ter - egyDb
For Each CV In Selection
Range(CV.Address) = 0
Db = Db + 1
If Db >= nullaDb Then Exit For
Next
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection = 1
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.
Új hozzászólás Aktív témák
- Hegesztés topic
- Politika
- USB to S/PDif konverter a modern RIAA, elektroncsövekkel
- Xiaomi 13T és 13T Pro - nincs tétlenkedés
- Sorozatok
- AMD K6-III, és minden ami RETRO - Oldschool tuning
- ASUS ROG PG32UCDM: OLED csúcsmonitor tesztje
- Háztartási gépek
- Azonnali VGA-s kérdések órája
- Computex 2024: Itt az új ROG Ally
- További aktív témák...
Állásajánlatok
Cég: Ozeki Kft.
Város: Debrecen
Cég: Alpha Laptopszerviz Kft.
Város: Pécs