ну... можно примерно, вот так:
Sub xText()
Dim OrigSheet As Worksheet
Dim NewSheet As Worksheet
Set OrigSheet = ActiveSheet
Set NewSheet = Worksheets.Add
NewSheet.Name = "Result"
orig_num = 0
For i = 1 To 10 'Cells.Rows.Count
j = 1
end_flag = 0
While j <= orig_num And end_flag = 0
If NewSheet.Cells(j, 1).Text + NewSheet.Cells(j, 2).Text = OrigSheet.Cells(i, 1).Text + OrigSheet.Cells(i, 2).Text Then
end_flag = 1
NewSheet.Cells(j, 3) = NewSheet.Cells(j, 3) + 1
End If
j = j + 1
Wend
If end_flag = 0 Then
orig_num = orig_num + 1
NewSheet.Cells(orig_num, 1) = OrigSheet.Cells(i, 1).Text
NewSheet.Cells(orig_num, 2) = OrigSheet.Cells(i, 2).Text
NewSheet.Cells(orig_num, 3) = 1
End If
Next i
End Sub