درخواست یک کد شرط

[hamalous]

سلام من یه کد دارم بصورت زیر:

Private Sub Button1_Click() On Error Resume Next Dim tmp As String Dim filepath As String cmdg.CancelError = True cmdg.ShowOpen If Err = 32755 Then Exit Sub End If filepath = cmdg.FileName Open filepath For Input As #1 tmp = Input(LOF(1), #1) Close #1 out = tmp Dim i% Dim x() As String x = Split(out, vbCrLf) Dim y() As String, z As String, j As Integer For i = 0 To UBound(x) y() = Split(x(i), vbTab) If y(1) = "5-5" Then z = Left(y(0), 5) + "0" + vbTab + "4-4" For j = 1 To 9 z = z + vbCrLf + Left(y(0), 5) + CStr(j) + vbTab + "4-4" Next j out = Replace(out, x(i), z) End If Next i Text1 = out Close #1 MsgBox "ÚãáíÇÊ ÇäÌÇã ÔÏ" End Sub

کد بالا عبارت زیر رو :
5-5 12345
-------------
تبدیل میکنه به :
4-4 123450
4-4 123451
4-4 123452
4-4 123453
4-4 123454
4-4 123455
4-4 123456
4-4 123457
4-4 123458
4-4 123459
خب این کد با این شرط که ستون دوم 5-5 باشه تبدیل رو انجام میده من می خوام علاوه براین شرط یه شرط دیگه هم در نظر بگیره و اون اینه که اگه 5 رقم ستون اول عبارت 5-5 12345، 10 بار یا بیشتر تکرار شده بود یا بعبارتی اگه از 5 رقم ستون اول 10 تا یا بیشتر وجود داشت تبدیل رو انجام بده ممنون میشم راهنمایی کنید

 

[the_king]

سوال تون مبهمه، قاعده مشخصی برای تبدیل و قواعد مقادیر ستون ها در نظر نگرفته اید یا اگر مشخص است در پست تون ابراز نکرده اید.
در مثال زیر پنج رقم ابتدایی همه ستون های اول 47923 است، فرض کنید که تعدادشان هم 15 تا سطر است، اینها حالا باید به چه تبدیل شوند؟

4792311	4-4
4792323	2-2
4792341	4-3
.
.
.
4792319	2-4
4792382	3-3
4792335	2-4

 

[the_king]

سلام ممنون از توجه تون ببینید دوست عزیز من کاری با اینکه چطور اون یک کد به 10 کد تبدیل میشه رو ندارم فقط می خوام یک شرط به کد اضافه کنم اون شرط رو نمی تونم بنویسم شرط هم اینه:اگه 5 رقم ستون اول 10 بار یا بیشتر تکرار شده باشه اون موقع و ...فقط همین یه شرط رو می خوام لطف کنید برام بنویسید یا به زبان ویژوال بیسیک :if left(y(0),5) => از 10 بار تکرار شده باشه thenکه بجای این شرط درون کد قرار بگیره :If y(1) = "5-5" Then

    Dim y() As String, z As String, j As Integer
[B][COLOR="#0000CD"]    Dim k As Integer, c As Integer[/COLOR][/B]
    For i = 0 To UBound(x)
        y() = Split(x(i), vbTab)
[B][COLOR="#0000CD"]        c = 0
        For k = 0 To UBound(x)
            If Left(x(k), 5) = Left(x(i), 5) Then
                c = c + 1
            End If
        Next
        If c > 10 Then
[/COLOR][/B]            z = Left(y(0), 5) + "0" + vbTab + "4-4"
            For j = 1 To 9
                z = z + vbCrLf + Left(y(0), 5) + CStr(j) + vbTab + "4-4"
            Next j
            out = Replace(out, x(i), z)
        End If
    Next i

 

[the_king]

سلام دوستان و ممنون بابت کدتون عالی بود من یه کد دارم که10 عبارت زیر ر و:
4-4 123450
4-4 123451
4-4 123452
4-4 123453
4-4 123454
4-4 123455
4-4 123456
4-4 123457
4-4 123458
4-4 123459

تبدیل میکنه به این عبارت :
5-5 12345
یعنی عکس کد برنامه پست 1 ، این کد یه مشکل داره اونم اینه که اون 10 عبارت حتما باید پشت سر هم باشه تا تبدیل صورت بگیره حالا از دوستان کسی می تونه مشکل رو حل کنه یعنی اگه 10 کد هم پشت سر هم نبود تبدیل رو انجام بده ، الگوریتم هم میگم شاید بدرد بخوره به اینصورت هست که رقم آخر ستون اول 10 عبارت حذف میشه و یکی به ستون دوم اضافه میشه یعنی 4-4 میشه 5-5، ممنون

    Dim i As Integer, j As Integer
    Dim x() As String, c() As Integer, g() As Integer, y() As String
    Dim n As String, s As String
    x = Split(Text1.Text, vbCrLf)
    ReDim c(0 To UBound(x)), g(0 To UBound(x))
    For i = 0 To UBound(x)
        c(i) = 1
        g(i) = i
    Next
    For i = 0 To UBound(x)
        If Len(x(i)) > 0 Then
            If g(i) = i Or c(g(i)) < 10 Then
                y() = Split(x(i), vbTab)
                n = Left(y(0), Len(y(0)) - 1)
                For j = i + 1 To UBound(x)
                    If Len(x(j)) > 0 Then
                        If n = Left(x(j), Len(n)) Then
                            c(i) = c(i) + 1
                            c(j) = 0
                            g(j) = i
                        End If
                    End If
                Next
                If g(i) = i And c(i) >= 10 Then
                    x(i) = n & vbTab & CStr(Val(y(1)) + 1) & "-" & CStr(Val(y(1)) + 1)
                End If
                s = s + x(i) + vbCrLf
            End If
        End If
    Next
    Text1.Text = s