-
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
-
Fferi50
Topikgazda
Szia!
Közben elkészült a makró.
Ezt másold be az adatokat tartalmazó munkalapod kódlapjára, a következők szerint:
A munkalap fülön jobb egérgomb - Kód megjelenítése - a General fülbe másold be.Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, ActiveSheet.ListObjects(1).DataBodyRange) Is Nothing Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False
egyedidb
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub egyedidb()
Dim rrange As Range, frange As Range, i As Integer
Set rrange = ActiveSheet.ListObjects(1).DataBodyRange
Set frange = Cells(1, Munka1.ListObjects(1).Range.Columns.Count + 3)
For i = 1 To rrange.Columns.Count
If i = 1 Then
rrange.Columns(i).Copy frange
Else
rrange.Columns(i).Copy frange.End(xlDown).Offset(1, 0)
End If
Next
Range(frange, frange.End(xlDown)).RemoveDuplicates 1, xlNo
frange.offset(0,-1).Value = frange.End(xlDown).Row
Range(frange, frange.Offset(rrange.Cells.Count, 0)).Clear
End Sub
Az első makró eseménykezelésre szolgál, azt nézi, hogy a táblázatodban van-e a változás. Ha igen, akkor megszámolja az egyedi értékeket, ha nem, akkor nem történik semmi.
A második makró (egyedidb) számol ténylegesen: A táblázattól jobbra a 3. oszlopba kigyűjti az értékeket egymás alá és utána a jobbra 2. cellába beírja az eredményt. A számolásokat nem fogod látni.
FONTOS! Ha a táblázatot lefelé bővíted, azt is beszámolja a makró. Az egyes oszlopokba nem szabad üres cellákat hagyni, akkor tudja beszámolni.
A munkafüzetet makróbarátként kell mentened és a makrókat engedélyezned kell a beállítások - biztonság fülön.
Remélem sikerül, ha gondod lenne, írj bátran.
Üdv.
Új hozzászólás Aktív témák
- Milyen asztali (teljes vagy fél-) gépet vegyek?
- One otthoni szolgáltatások (TV, internet, telefon)
- Mini-ITX
- Wise (ex-TransferWise)
- Samsung Galaxy S25 Ultra - titán keret, acélos teljesítmény
- Videó stream letöltése
- Házimozi haladó szinten
- Kormányok / autós szimulátorok topikja
- Debrecen és környéke adok-veszek-beszélgetek
- Milyen egeret válasszak?
- További aktív témák...
- Apple iPhone 16 Pro Max Natural Titanium Titán dizájn, Pro kamera 5 zoommal,120 Hz ProMotion,100%
- Lenovo Tab M10 64GB, Kártyafüggetlen, 1 Év Garanciával
- ÁRCSÖKKENTÉS Menő retró konfig: Q9550, Gigabyte P43, 4GB RAM, ASUS GT730
- Cisco Catalyst C1000-48T-4G-L 48xRJ45 4xSFP switch, CISCO refurbished
- LG 27GP95RP - 27" Nano IPS - UHD 4K - 160Hz 1ms - NVIDIA G-Sync - FreeSync Premium PRO - HDR 600
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: NetGo.hu Kft.
Város: Gödöllő