[sooriaty03]

السلام عليكم
أخي الكريم عذرا على التأخير
تفضل هذا هو الكود

كود :

Imports Microsoft.Office.Interop
Public Class Form1
    Dim exl_app As Excel.Application = CreateObject("Excel.Application")
    Dim Values, Counter As New List(Of String)
    Dim DateValues, CountryValues As New List(Of String)
    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Values.Clear()
        Counter.Clear()
        DateValues.Clear()
        CountryValues.Clear()
        ReadFromExcel("c:\Book.xlsx")
        SaveToExcel(Application.StartupPath & "\Book0.xlsx")
    End Sub
    Private Sub ReadFromExcel(ByVal FileName As String)
        Dim exl_wrk As Excel.Workbook
        Dim exl_wst As Excel.Worksheet
        exl_wrk = exl_app.Workbooks.Open(FileName)
        exl_wst = exl_wrk.Worksheets(1)
        With exl_wst
            Dim Value1, Value2, Value3 As String
            Dim Index1, Index2, Index3 As Integer
            For I = 1 To .UsedRange.Rows.Count
                If Not String.IsNullOrEmpty(.Range("D" & I).Value) Then
                    Value1 = .Range("D" & I).Value.ToString.Split(" ")(0)
                    Value2 = .Range("E" & I).Value
                    Index1 = DateValues.IndexOf(Value1)
                    Index2 = CountryValues.IndexOf(Value2)
                    Application.DoEvents()
                    If Index1 = -1 Then
                        DateValues.Add(Value1)
                        Index1 = DateValues.Count - 1
                    End If
                    If Index2 = -1 Then
                        CountryValues.Add(Value2)
                        Index2 = CountryValues.Count - 1
                    End If
                    Value3 = Index1.ToString & "," & Index2.ToString
                    Index3 = Values.IndexOf(Value3)
                    If Index3 = -1 Then
                        Values.Add(Value3)
                        Index3 = Values.Count - 1
                        Counter.Add("0")
                    End If
                    Counter.Item(Index3) = Val(Counter.Item(Index3)) + 1
                End If
            Next
        End With
        exl_wrk.Close()
        exl_app.Quit()
    End Sub
    Private Sub SaveToExcel(ByVal FileName As String)
        Dim exl_wrk As Excel.Workbook
        Dim exl_wst As Excel.Worksheet
        exl_wrk = exl_app.Workbooks.Add
        exl_wst = exl_wrk.Worksheets(1)
        With exl_wst
            .Cells(1, 1) = "اسم الدولة"
            Dim Index As Integer = 0
            For I = 2 To DateValues.Count + 1
                .Cells(1, I).NumberFormat = "@"
                .Cells(1, I) = DateValues.Item(I - 2)
                For H = 2 To CountryValues.Count + 1
                    .Cells(H, 1) = CountryValues.Item(H - 2)
                    Index = Values.IndexOf((I - 2).ToString & "," & (H - 2).ToString)
                    If Index = -1 Then
                        .Cells(H, I) = 0
                    Else
                        .Cells(H, I) = Counter.Item(Index)
                    End If
                Next
            Next
        End With
        exl_wrk.SaveAs(FileName)
        exl_wrk.Close()
        exl_app.Quit()
    End Sub
End Class

بالتوفيق