Düşeyaranın Sadece İlk Bulduğunu Getirmesi. Yardım!

[Kekoli]

Merhaba,
Ekli dosyada arkaplanı sarı olan kısmı tablom olduğunu düşünün
kırmızı olan hücreye de yazacağım formül sonrası gelmesini istediğim veriyi yazdım.

 

[Ali]

Bir modüle aşağıdaki kodları ekleyin.

Function aconcat(a As Variant, Optional sep As String = "") As String
' Harlan Grove
Dim y As Variant
If TypeOf a Is Range Then
For Each y In a.Cells
aconcat = aconcat & y.Value & sep
Next y
ElseIf IsArray(a) Then
For Each y In a
aconcat = aconcat & y & sep
Next y
Else
aconcat = aconcat & a & sep
End If
aconcat = Left(aconcat, Len(aconcat) - Len(sep))
End Function

Sonra G2 hücresine

=DEĞİŞTİR(aconcat(EĞER(SIKLIK(EĞER($B$2:$B$100<>"";EĞER($A$2:$A$100=$F2;KAÇINCI($B$2:$B$100;$B$2:$B$100;0)));SATIR($B$2:$B$100)-SATIR($B$2)+1);", "&$B$2:$B$100;""));1;2;"")

yazıp CTRL+SHIFT+ENTER tuşlarına basarak dizi formülü oluşturun.

 

[Ali]

Diğer alternatif

Bir modüle aşağıdaki kodları ekleyin

Function LookUpConcat(ByVal SearchString As String, SearchRange As Range, ReturnRange As Range, _
                      Optional Delimiter As String = " ", Optional MatchWhole As Boolean = True, _
                      Optional UniqueOnly As Boolean = False, Optional MatchCase As Boolean = False)
                  
  Dim X As Long, CellVal As String, ReturnVal As String, Result As String
 
  If (SearchRange.Rows.Count > 1 And SearchRange.Columns.Count > 1) Or _
     (ReturnRange.Rows.Count > 1 And ReturnRange.Columns.Count > 1) Then
    LookUpConcat = CVErr(xlErrRef)
  Else
    If Not MatchCase Then SearchString = UCase(SearchString)
    For X = 1 To SearchRange.Count
      If MatchCase Then
        CellVal = SearchRange(X).Value
      Else
        CellVal = UCase(SearchRange(X).Value)
      End If
      ReturnVal = ReturnRange(X).Value
      If MatchWhole And CellVal = SearchString Then
        If UniqueOnly And InStr(Result & Delimiter, Delimiter & ReturnVal & Delimiter) > 0 Then GoTo Continue
        Result = Result & Delimiter & ReturnVal
      ElseIf Not MatchWhole And CellVal Like "*" & SearchString & "*" Then
        If UniqueOnly And InStr(Result & Delimiter, Delimiter & ReturnVal & Delimiter) > 0 Then GoTo Continue
        Result = Result & Delimiter & ReturnVal
      End If
Continue:
    Next
    
    LookUpConcat = Mid(Result, Len(Delimiter) + 1)
  End If
 
End Function

G2 hücresine de

=LookUpConcat(F2;A$2:A$100;B$2:B$100;", ")

yazın.

 

[Kekoli]

ikinci yazdığınız muhteşem oldu, açıklama yapabilir misiniz? biraz da öğrenelim