-
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
-
félisten
-
föccer
nagyúr
Simán fkeres() függvény megoldja.
A legördülő listát Adatok-Érvényesítésnél találod. Ott kell listát választani és kipipálni h legyen legördülő.
Erre rá kell építeni 1-1 FKERES fv-t.
Szebb megoldás, O365-nél működik, hogy SZŰRŐ függvényt használsz.
üdv, föccer
Építésztechnikus. Építőmérnök.
-
lappy
őstag
Kiszámolod egy segédoszlopba és ezzel át tudod helyezni ami nagyobb
Sub Rhair()
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("Munka1").UsedRange.Rows.Count
J = Worksheets("Munka2").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Munka2").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Munka1").Range("D1:D" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) > "360" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Munka2").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "Done" Then
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub[ Szerkesztve ]
Bámulatos hol tart már a tudomány!
-
Delila_1
Topikgazda
Egy másik módszer (nem kell hozzá segédoszlop).
Sub Masolas()
Dim sor As Integer, usor As Integer, ide As Integer
Sheets("Munka1").Select
Rows(1).Copy Sheets("Munka2").Cells(1) 'címsor másolása
usor = Range("A" & Rows.Count).End(xlUp).Row
ide = 2
For sor = 2 To usor
If Cells(sor, 3) - Cells(sor, 2) >= 360 Then
Rows(sor).Copy Sheets("Munka2").Range("A" & ide)
ide = ide + 1
Rows(sor).EntireRow.Delete
End If
Next
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
Módosítottam a makrón. Mint írtam, nem szükséges a D oszlop, ami a két dátum között eltelt napokat számolja.
Sub Masolas()
Dim sor As Integer, ide As Integer
Sheets("Munka2").Columns("A:D").ClearContents
Range("A1:C1").Copy Sheets("Munka2").Cells(1) 'címsor másolása
Sheets("Munka1").Select
ide = 2: sor = 2
Do While Cells(sor, 1) > ""
If Cells(sor, 3) - Cells(sor, 2) >= 360 Then
Rows(sor).Copy Sheets("Munka2").Range("A" & ide)
Rows(sor).EntireRow.Delete
ide = ide + 1: sor = sor - 1
End If
sor = sor + 1
Loop
End Sub
A Munka1 lapon az első sort magasabbra vettem, hogy rendesen elférjen a frissítő gomb. Ez egy alakzat (lekerekített sarkú téglalap, de lehet bármi más is), ehhez rendeltem a Masolas makrót.
Eredeti Munka1 lap:
A makró indítása után:
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
- Ukrajnai háború
- Fotók, videók mobillal
- Poco F5 - pokolian jó ajánlat
- Célkeresztben az OnlyFans, amiért pornót nézhetnek a gyerekek
- Napelem
- Honor Magic V2 - origami
- Miért vezet mindenki úgy, mint egy állat?
- Itt az első kép a 2024-es Nokia 3210-ről
- Robogó, kismotor
- Gaming notebook topik
- További aktív témák...
- Eredeti Microsoft termékek - MEGA Akciók! Windows, Office Pro Plus, Project Pro, Visio Pro stb.
- Vírusirtó, Antivirus VPN kulcsok
- PC JÁTÉKOK (OLCSÓ STEAM, EA , UPLAY KULCSOK ÉS SOKMINDEN MÁS IS 100% GARANCIA )
- Adobe Creative Cloud - 2024. 04. 05 - 2025. 04. 05-ig
- Játékkulcsok olcsón: Steam, Uplay, GoG, Origin, Xbox, PS stb.