-
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
- ÁRGARANCIA!Épített KomPhone Ryzen 7 7800X3D 32/64GB RAM RTX 5090 32GB GAMER PC termékbeszámítással
- Corsair VENGEANCE RGB PRO 16GB (2x8GB) DDR4 3200MHz CMW16GX4M2Z3200C16
- 27% ÁFÁS DELL Alienware 16X Aurora Ultra 7 / RTX 5060 Részletfizetés megoldható. Beszámítás van.
- Samsung Galaxy Book 3 Amoled 360 i5 13.gen, 16GB RAM, 512GB SSD, érintőkijelzős kedvező áron!
- Eladó egy Huawei GT3 okos óra Dobozzal tőltővel
Állásajánlatok
Cég: Laptopműhely Bt.
Város: Budapest

Fferi50