Új hozzászólás Aktív témák

• #28216 Delila_1 veterán nyirisandor #28212

  Új Válasz 2015-08-25 12:39:47 #28216

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  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 Sub

  Szerk. 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.

• #28215 poffsoft veterán nyirisandor #28212

  Új Válasz 2015-08-25 12:32:30 #28215

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  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 Function

  forrás

  több

  ha 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