Kod:
Sub Birlestir()
Dim d As Object, i As Long, s, deg, S1 As Worksheet
Set S1 = Sheets("1")
Set d = CreateObject("Scripting.Dictionary")
Application.ScreenUpdating = False
Sheets("2").Select
For i = 2 To S1.Cells(Rows.Count, "B").End(xlUp).Row
deg = S1.Cells(i, "B")
If Not d.exists(deg) Then
s = S1.Cells(i, "C")
d.Add deg, s
Else
s = d.Item(deg)
s = s & "--" & S1.Cells(i, "C")
d.Item(deg) = s
End If
Next i
Range("A2:C" & Rows.Count).ClearContents
Range("A2") = 1
Range("A2:A" & d.Count + 1).DataSeries Rowcol:=xlColumns, _
Type:=xlLinear, Date:=xlDay, Step:=1
Range("B2").Resize(d.Count, 2) = _
Application.Transpose(Array(d.keys, d.items))
Application.ScreenUpdating = True
End Sub
İlgili makroyu çalıştırdığımda Run time error '13' type mismatch hatası alıyorum yardımcı olabilir misiniz ?
