PHP Kod:
Sub Aktar()
Dim syfKimya As Worksheet, bul, ara As Range, say As Integer, i As Integer
Dim bul2 As Range
say = 7
With ThisWorkbook.Worksheets("Kimya")
For i = 4 To 10
bul = Application.Match(Cells(i, "B").Value2, .Range("C:C"), 0)
If Not IsError(bul) Then
For Each ara In .Range("I" & bul & ":BR" & bul)
If Len(Trim(ara.Value)) > 0 Then
If Trim(Cells(3, say).Value) = "" Then
Set bul2 = Range("G3:T3").Find(.Cells(2, ara.Column).Value2, , , 1)
If Not bul2 Is Nothing Then
Cells(3, bul2.Column).Value = .Cells(2, ara.Column).Value
Else
Cells(3, say).Value = .Cells(2, ara.Column).Value
say = say + 1
End If
Set bul2 = Nothing
End If
End If
Next
End If
Next
End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [B4:B10]) Is Nothing Then
Range("G3:T3").Value = ""
Aktar
End If
End Sub
