sooriaty03 كتب :السلام عليكم
تفضل أخي الكريم
هذا الكود لا يعتمد على عدد معين من التواريخ فمهما بلغ العدد سيذكر لك جميع قيم التاريخ وكل قيمة كم مرة تكررت
كود :
Imports Microsoft.Office.Interop
Public Class Form1
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim exl_app As New Excel.Application
Dim exl_wrk As Excel.Workbook
Dim exl_wst As Excel.Worksheet
exl_app = CreateObject("Excel.Application")
exl_wrk = exl_app.Workbooks.Open("c:\Book1.xlsx")
exl_wst = exl_wrk.Worksheets(1)
Dim Counter As New List(Of String)
Dim Values As New List(Of String)
With exl_wst
Dim Value As String
Dim Index As Integer
For I = 1 To .UsedRange.Rows.Count
If Not String.IsNullOrEmpty(.Range("D" & I).Value) Then
Value = .Range("D" & I).Value.ToString.Split(" ")(0)
Index = Values.IndexOf(Value)
Application.DoEvents()
If Index = -1 Then
Values.Add(Value)
Counter.Add("1")
Else
Counter.Item(Index) = Val(Counter.Item(Index)) + 1
End If
End If
Next
End With
'إذا أردت إضافتهم إلى أداة نص
'تستطيع استخدامها في حال كان عندك تاريخين فقط
TextBox1.Text = Values.Item(0)
TextBox2.Text = Values.Item(1)
TextBox3.Text = Counter.Item(0)
TextBox4.Text = Counter.Item(1)
'إذا أردت إضافتهم إلى قائمة
'تستطيع استخدامها مهما كان عدد التواريخ
ListBox1.Items.AddRange(Values.ToArray)
ListBox2.Items.AddRange(Counter.ToArray)
End Sub
End Class
بالتوفيق
شكرا اخى العزيز
اخر طلب واسف انى اكون طولت عليك او ارهقتك من كتر الاسأله
كيف اربط بين عمودين بحيث احسب عدد مرات تكرار التاريخ المقابل لاسم دوله معين
كويس كتب :شكرا اخى العزيز
اخر طلب واسف انى اكون طولت عليك او ارهقتك من كتر الاسأله
كيف اربط بين عمودين بحيث احسب عدد مرات تكرار التاريخ المقابل لاسم دوله معين
السلام عليكم
تفضل أخي الكريم هذا هو الكود
ضع ثلاث أدوات مربع نص الأول للتاريخ - الثاني للدولة - الثالث للنتيجة
كود :
Imports Microsoft.Office.Interop
Public Class Form1
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim exl_app As New Excel.Application
Dim exl_wrk As Excel.Workbook
Dim exl_wst As Excel.Worksheet
exl_app = CreateObject("Excel.Application")
exl_wrk = exl_app.Workbooks.Open("c:\Book1.xls")
exl_wst = exl_wrk.Worksheets(1)
Dim Counter As Integer = 0
With exl_wst
Dim Value1, Value2 As String
For I = 1 To .UsedRange.Rows.Count
Value1 = .Range("D" & I).Value
Value2 = .Range("C" & I).Value
Application.DoEvents()
If Value1 = TextBox1.Text AndAlso Value2 = TextBox2.Text Then
Counter += 1
End If
Next
End With
TextBox3.Text = Counter
End Sub
End Class
بالتوفيق
عليكم السلام ورحمة الله وبركاته
شكرا لمساعدتك اخى الكريم
كنت اقصد ان التواريخ التى بالشيت تضاف تلقائيا فى ملف اكسيل جديد والدولة ثم النتيجه
او فى ليست بوكس حتى
شكرا لك مره اخرى
sooriaty03 كتب :تفضل هذا هو الكود
كود :
Imports Microsoft.Office.Interop
Public Class Form1
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim exl_app As New Excel.Application
Dim exl_wrk As Excel.Workbook
Dim exl_wst As Excel.Worksheet
exl_app = CreateObject("Excel.Application")
exl_wrk = exl_app.Workbooks.Open("c:\Book1.xlsx")
exl_wst = exl_wrk.Worksheets(1)
Dim Counter As New List(Of String)
Dim Values As New List(Of String)
With exl_wst
Dim Value1, Value2 As String
Dim Index 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
Index = Values.IndexOf(Value1)
Application.DoEvents()
If Index = -1 Then
Values.Add(Value1)
Counter.Add("0")
Index = Values.Count - 1
End If
Counter.Item(Index) = Val(Counter.Item(Index)) + IIf(Value2 = TextBox1.Text, 1, 0)
End If
Next
End With
ListBox1.Items.AddRange(Values.ToArray)
ListBox2.Items.AddRange(Counter.ToArray)
End Sub
End Class
بالتوفيق
شكرا للمساعده مره اخرى اخى العزيز
الكود لا يعمل لا ادرى لماذا
ارجو ان تراجع الكود ولو تكون النتائج على ملف اكسيل جديد يكون افضل
توضيح مره اخرى لما اريده فى السطر الاول اريد ان تكتب التواريخ التى بالشيت ثم فى العمود الاول تكتب اسماء الدول وتحت التواريخ تكتب كم مره ظهر اسم الدوله والتاريخ مثل المثال الاتى
اسم الدوله---1/1/2012---------2/1/2012
مصر----------5-------------------7
سوريا---------9-------------------4
السودان--------2 -------------------11
السعوديه-------5 -------------------3
السلام عليكم
أخي الكريم عذرا على التأخير
تفضل هذا هو الكود
كود :
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
بالتوفيق
شكرا لسعة صدرك
التاريخ بيظهر ب 2 فورمات رغم ان الشيت فيه فورمات واحد بس
02/Apr/2013
18/02/2013
يعنى بيقلب شوية تواريخ اول مابيفتح الشيت