-
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
veterán
válasz
nyirisandor
#28232
üzenetére
Nem , még csak most végeztem.
Delila megoldását is alkalmazva, a munka1-en makrós, munka2-n függvényes megoldás
[link] -
Delila_1
veterán
válasz
nyirisandor
#28232
üzenetére
Valószínű, hogy azóta poffsoft már válaszolt privátban, de ha nem, ez is megteszi.
Mikor egy új nevet viszel be a B oszlopba, a jobb oldali táblázat automatikusan frissül.
Az A1:B1 és a D1:G1 tartományban megszüntettem a cellák összevonását. Javaslom, hogy ezután is kerüld ezt a formázási lehetőséget, mert elég sok galibát okozhat.
Egyenként jelöld ki a két tartományt, és a cellaformázásnál nézd meg a vízszintes elrendezés beállítását. -
poffsoft
veterán
válasz
nyirisandor
#28230
üzenetére
töltsd fel a data.hu-ra (vagy a google drive-odra, ha van), és a letöltő linket posztold ide.
Vagy küldd el emailben. -
Delila_1
veterán
válasz
nyirisandor
#28212
üzenetére
A lapodhoz kell rendelned a makrót. Keress rá a laphoz rendelésre.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim usor As Long
If Target.Column = 2 And Target.Row > 2 And Target.Count = 1 Then
Application.EnableEvents = False
usor = Range("B" & Rows.Count).End(xlUp).Row
Range("B3:B" & usor).Copy Range("D3")
Range("E3:E" & usor).ClearContents
ActiveSheet.Range("$D$3:$D$" & usor).RemoveDuplicates Columns:=1, Header:=xlNo
usor = Range("D" & Rows.Count).End(xlUp).Row
Range("E3:E" & usor) = "=countif(B:B,D3)"
Application.EnableEvents = True
End If
End SubSzerk. Látom, már kaptál választ, míg én irkáltam.
Mikor új nevet viszel be a B oszlopba, a D és E oszlop felülíródik az új értékekkel.
-
poffsoft
veterán
válasz
nyirisandor
#28212
üzenetére
Szia,
google tömbképletes megoldásokat kínál.
Ha lehet makróval is:
Dim row As Range
Dim elements() As String
Dim elementSize As Integer
Dim newElement As Boolean
Dim i As Integer
Dim distance As Integer
Dim result As String
elementSize = 0
newElement = True
For Each row In rng.Rows
If row.Value <> "" Then
newElement = True
For i = 1 To elementSize Step 1
If elements(i - 1) = row.Value Then
newElement = False
End If
Next i
If newElement Then
elementSize = elementSize + 1
ReDim Preserve elements(elementSize - 1)
elements(elementSize - 1) = row.Value
End If
End If
Next
distance = Range(Application.Caller.Address).row - rng.row
If distance < elementSize Then
result = elements(distance)
listUnique = result
Else
listUnique = ""
End If
End Functionha megvan a lista, már csak egy sima DARABTELI() amire szükséged van.
A példatáblát jobb lenne xls formátumban mellékelni

Új hozzászólás Aktív témák
- Redmi Note 12 Pro - nem tolták túl
- koxx: SCYROX V6 gamer egér
- Születésnapos a Noctua
- BestBuy topik
- Küszöbön az androidos PC-k
- Nikon DSLR topik
- The Division 2 (PC, XO, PS4)
- Vezetékes FEJhallgatók
- HiFi műszaki szemmel - sztereó hangrendszerek
- Brogyi: CTEK akkumulátor töltő és másolatai
- További aktív témák...
- Vírusirtó, Antivirus, VPN kulcsok
- Fallout 3 Collector's Edition (lunchbox)
- Árváltozás+játék DVD: Bioshock Infinite Ultimate Songbird Edition
- Árváltozás+játék!The Witcher 2 Assassins of Kings Collector's Edition
- AKCIÓ! Jogtiszta Windows - Office & Vírusirtó licencek- Azonnal - Számlával - Garanciával - Nint.hu
- Akció! Paidashu 10600MAH / 20700MAH Powerbank olcsón!
- Xiaomi Redmi 13 128GB, Kártyafüggetlen, 1 Év Garanciával
- Bomba ár! HP ProBook 645 G4 - Ryzen 7 PRO I 8GB I 256SSD I HDMI I 14" FHD I Cam I W11 I Garancia!
- GIGA AKCIÓ!!! AKTIVÁLATLAN iPad Air M2 11" WiFi + CELLULAR 512GB!!! KÉK
- Samsung Galaxy Z Fold 4 256GB,Újszerű,Dobozával, 12 hónap garanciával
Állásajánlatok
Cég: Promenade Publishing House Kft.
Város: Budapest
Cég: NetGo.hu Kft.
Város: Gödöllő

Fferi50
