Chuyển 1 chuỗi thành chuỗi khác! (1 người xem)

  • Thread starter Thread starter ThuNghi
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

ThuNghi

Hãy cho rồi sẽ nhận!
Thành viên đã mất
Tham gia
16/8/06
Bài viết
3,808
Được thích
4,449
Nhờ các cao thủ hay thấp thủ giúp tôi viết 1 UDF tách chuỗi sau thành 1 chuỗi khác.
Text1: 150001-3,15,16,28-29
Thành
Text2: 150001, 150002, 150003, 150015, 150016, 150028, 150029

Cụ thể:
150001-3 là 150001, 150002, 150003
...
Các chuỗi con luôn là 6 ký tự bắt đầu là 15 và tiếp là số 0.
Xin cám ơn!
 
Thử cái này xem nha ThuNghi, mua thêm Ken bỏ vào kho, ghi TK ptm
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Có sửa lại 1 tí:
2-3,8,...
Nghĩa là số nhỏ hơn 10, file trước bị sai. Vui lòng tải lại file bài trên.
Còn dấu phẩy cuối theo Thu Nghi cho biết thì không bao giờ có.
Các bẫy lỗi khác nếu có thì dễ, Thu Nghi tự làm được.
 
Upvote 0
Bác PTM triển khai thêm giúp
Text1: 150001-3,15,16,110028-29
Thành
Text2: 150001, 150002, 150003, 150015, 150016, 110028, 110029

Cụ thể:
150001-3 là 150001, 150002, 150003

110028-29 là 110028, 110029 số 1500, 1100 ở đầu là biến.

Nhờ các bạn làm giúp. Em đang tập tành viết UDF thôi.
Cám ơn nhiều!
 
Lần chỉnh sửa cuối:
Upvote 0
ThuNghi thử code này xem thế nào (làm đại)
PHP:
Function ConvertText(Chuoi As String) As String
  Dim Temp1, Temp2, Temp As String, Item, i As Long
  On Error Resume Next
  Temp1 = Split(Chuoi, ",")
  For Each Item In Temp1
    If Len(Item) > 5 Then Temp = Left(Item, 4)
    If InStr(Item, "-") Then
      For i = Mid(Item, InStr(Item, "-") - 2, 2) To Mid(Item, InStr(Item, "-") + 1, Len(Item))
        Temp2 = Temp2 & ", " & Temp * 100 + i
      Next i
    Else
      Temp2 = Temp2 & ", " & Temp * 100 + Item
    End If
  Next Item
  ConvertText = Mid(Temp2, 3, Len(Temp2))
End Function
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Cũng bị cái lỗi ban đầu như lỗi của lão chết tiệt, ndu ơi. Chuỗi này, có len(Item)<5 nên không thèm liệt kê:
150001-3, 5,7-9, 15,16,200028-29,,,
 
Upvote 0
Cũng bị cái lỗi ban đầu như lỗi của lão chết tiệt, ndu ơi. Chuỗi này, có len(Item)<5 nên không thèm liệt kê:
150001-3, 5,7-9, 15,16,200028-29,,,
Vậy em sửa lại tí:
PHP:
Function ConvertText(Chuoi As String) As String
  Dim Temp As String, Pref As String, i As Long, Item1, Item2
  On Error Resume Next
  For Each Item1 In Split(Chuoi, ",")
    If Len(Item1) > 5 Then Pref = Left(Item1, 4)
    If InStr(Item1, "-") Then
      For i = Right(Split(Item1, "-")(0), 2) To Right(Split(Item1, "-")(1), 2)
        Temp = Temp & ", " & Pref * 100 + i
      Next i
    Else
      Temp = Temp & ", " & Pref * 100 + Right(Item1, 2)
    End If
  Next Item1
  ConvertText = Mid(Temp, 3, Len(Temp))
End Function
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
TextFromTo Function

Gửi các bạn hàm TextFromTo
Hàm TextFromTo tôi viết đáp ứng cho nhu cầu tổng quát về tạo danh sách chuỗi mã theo chuỗi định nghĩa và khoảng giá trị xác định.

Các trường hợp sau có thể vận dụng được hàm TextFromTo
+ 150001-3,15,16,28-29
KQ: 150001,150002,150003,150015,150016,150028,150029

+ 00000-3,5-13,14,15-18,19
KQ: 00000,00001,00002,00003,00005,00006,00007,00008,00009,00010,00011,00012,00013,00014,00015,00016,00017,00018,00019

+ PT000-3,4-13,14,15-18,19
KQ: PT000,PT001,PT002,PT003,PT004,PT005,PT006,PT007,PT008,PT009,PT010,PT011,PT012,PT013,PT014,PT015,PT016,PT017,PT018,PT019

+ T100,1-2,3-5ABC, 6
KQ: T100,T101,T102,T106

Giá trị đầu tiên được lấy làm mẫu để tạo các mã trong danh sách.

Mã nguồn:
Mã:
''--------------------------------------------------------------------------
'Author: Nguyen Duy Tuan - www.bluesofts.net
'--------------------------------------------------------------------------
Option Explicit

Function TextFromTo(ByVal cText As String) As String
    Dim ArrText
    Dim lb&, ub&, I&, P1&
    Dim cFirstValue$, cText1$, cTextRet$
    Dim FirstNum&, lNum&

    'cText = "150001-3,15,16,28-29"
    ArrText = Split(cText, ",")
    
    lb = LBound(ArrText, 1)
    ub = UBound(ArrText, 1)
    
    cFirstValue = ArrText(lb)
    P1 = InStr(cFirstValue, "-")
    If P1 > 0 Then
        cFirstValue = Left$(cFirstValue, P1 - 1)
    End If
    
    For I = Len(cFirstValue) To 1 Step -1
        If Not IsNumeric(Mid(cFirstValue, I)) Then
            FirstNum = I
            Exit For
        End If
    Next I
    
    FirstNum = FirstNum + 1
    
    If FirstNum > 1 Then
        cText1$ = Left(cFirstValue, FirstNum - 1)
    Else
        cText1$ = ""
    End If
    
    lNum = CLng(Mid(cFirstValue, FirstNum))
    
    For I = lb To ub
        If ArrText(I) <> "" Then
            cTextRet = GetText(cFirstValue, cText1, lNum, ArrText(I))
            If cTextRet <> "" Then
                If TextFromTo = "" Then
                    TextFromTo = cTextRet
                Else
                    TextFromTo = TextFromTo & "," & cTextRet
                End If
            End If
        End If
    Next I
    
End Function
'--------------------------------------------------------------------------
Function GetText(ByVal cFirstValue As String, ByVal cFirstText As String, ByVal lNum As Long, ByVal cSubText As String) As String
    Dim ArrText
    Dim cText$
    Dim I&, lb&, ub&, lNum1&, lNum2&
    Dim nLenthText&
    
    nLenthText = Len(cFirstValue)
    
    ArrText = Split(cSubText, "-")
    
    lb = LBound(ArrText, 1)
    ub = UBound(ArrText, 1)
    
    If (ub - lb = 0) Then
        If (ArrText(lb) = cFirstValue) Then
            GetText = ArrText(lb)
        Else
            If IsNumeric(ArrText(ub)) Then
                lNum2 = CLng(ArrText(ub))
                If lNum2 < lNum Then lNum2 = lNum + lNum2 - IIf(lNum Mod 10 = 0, 0, 1)
                GetText = FillName(nLenthText, cFirstText, CStr(lNum2))
            Else
                GetText = FillName(nLenthText, cFirstText, ArrText(ub))
            End If
        End If
        Exit Function
    ElseIf ArrText(lb) = cFirstValue Then
        If IsNumeric(ArrText(ub)) Then
            lNum2 = CLng(ArrText(ub))
        End If
        If lNum2 < lNum Then lNum2 = lNum + lNum2 - IIf(lNum Mod 10 = 0, 0, 1)
        
        For I = lNum To lNum2
            cText = FillName(nLenthText, cFirstText, CStr(I))
            If I = lNum Then
                GetText = cText
            Else
                GetText = GetText & "," & cText
            End If
        Next I
        Exit Function
    End If
    
    If IsNumeric(ArrText(lb)) Then
        lNum1 = CLng(ArrText(lb))
    End If
    If IsNumeric(ArrText(ub)) Then
        lNum2 = CLng(ArrText(ub))
    End If
    
    If lNum1 < lNum Then lNum1 = lNum + lNum1 - 1 + IIf(lNum Mod 10 = 0, 1, 0)
    If lNum2 < lNum Then lNum2 = lNum + lNum2 - IIf(lNum Mod 10 = 0, 0, 1)
    
    For I = lNum1 To lNum2
        cText = FillName(nLenthText, cFirstText, CStr(I))
        If GetText <> "" Then
            GetText = GetText & "," & cText
        Else
            GetText = cText
        End If
    Next I
End Function
'--------------------------------------------------------------------------
Function FillName(ByVal nLengthText As Long, ByVal Text1 As String, ByVal Text2 As String, Optional ByVal CharToFill As String = "0")
    Dim nLen&
    nLen = Len(Text1) + Len(Text2)
    
    If nLen < nLengthText Then
        FillName = Text1 & String$(nLengthText - nLen, CharToFill) & Text2
    Else
        FillName = Text1 & Text2
    End If
End Function
 

File đính kèm

Upvote 0
Dựa trên căn bản: "Các chuỗi con luôn là 6 ký tự" (sic), với yêu cầu 2 là 4 số đầu thay đổi (1500, 1100, ...) thì code của ndu đúng hơn cả. Thuật toán so với lão chết tiệt thì giống nhưng ngắn gọn hơn vì dùng phương thức split.
Code của TuanVNUNI thì hay quá (đọc chưa hiểu), vượt yêu cầu bài #1 nhưng chưa áp dụng được cho yêu cầu 2.
 
Upvote 0
Dựa trên căn bản: "Các chuỗi con luôn là 6 ký tự" (sic), với yêu cầu 2 là 4 số đầu thay đổi (1500, 1100, ...) thì code của ndu đúng hơn cả. Thuật toán so với lão chết tiệt thì giống nhưng ngắn gọn hơn vì dùng phương thức split.
Code của TuanVNUNI thì hay quá (đọc chưa hiểu), vượt yêu cầu bài #1 nhưng chưa áp dụng được cho yêu cầu 2.

Các code trên nếu cho ký tự chữ đứng trước sẽ bị sai. Nên làm cho trường hợp tổng quát để những người khác cùng được áp dụng.

Em đang chỉnh lại code của em, sẽ up lên sau.
 
Upvote 0
Các code trên nếu cho ký tự chữ đứng trước sẽ bị sai. Nên làm cho trường hợp tổng quát để những người khác cùng được áp dụng.

Em đang chỉnh lại code của em, sẽ up lên sau.
Tuân ơi... Mình không dám nói code của Tuân không hay, nhưng cho dù là áp dụng với các ký tự chử đứng trước (như PT00...) thì mình nghĩ code cũng không đến nổi dài như thế... Cải tiến lại, 1 UDF duy nhất, ngắn cở 1/3 cái trên cũng đã đủ lắm rồi
Mình đang tập tành, có thể ý kiến còn quá chủ quan (do chưa hiểu hết ý đồ của tác giả) nên có gì chưa phải trong phát biểu mong bạn lượng thứ cho
Mình nghĩ vấn đề nằm ở chổ bạn quá cẩn thận trong việc viết code chẳng?
-----------------
Dựa trên căn bản: "Các chuỗi con luôn là 6 ký tự" (sic), với yêu cầu 2 là 4 số đầu thay đổi (1500, 1100, ...) thì code của ndu đúng hơn cả. Thuật toán so với lão chết tiệt thì giống nhưng ngắn gọn hơn vì dùng phương thức split.
Code của TuanVNUNI thì hay quá (đọc chưa hiểu), vượt yêu cầu bài #1 nhưng chưa áp dụng được cho yêu cầu 2.
Cái này em học từ sư phụ mà... Ẹc.. Ẹc..
 
Upvote 0
Tuân ơi... Mình không dám nói code của Tuân không hay, nhưng cho dù là áp dụng với các ký tự chử đứng trước (như PT00...) thì mình nghĩ code cũng không đến nổi dài như thế... Cải tiến lại, 1 UDF duy nhất, ngắn cở 1/3 cái trên cũng đã đủ lắm rồi
Mình đang tập tành, có thể ý kiến còn quá chủ quan (do chưa hiểu hết ý đồ của tác giả) nên có gì chưa phải trong phát biểu mong bạn lượng thứ cho
Mình nghĩ vấn đề nằm ở chổ bạn quá cẩn thận trong việc viết code chẳng?
-----------------

Cái này em học từ sư phụ mà... Ẹc.. Ẹc..
Rất cám ơn các Bác.
Code của ndu là OK rồi, do không mình không nêu rõ điều kiện.
150001-3,15,16,200028-29,,,
thành
150001, 150002, 150003, 150015, 150016, 200028, 200029
Là đáp ứng được yêu cầu.
Bây giờ mình triển khai thêm nhé, mong các Bác hoàn thiện tiếp tục.

1,, x,aa1001,151001-3, 15,16,200028-29,,,

Thành

aa1001,151001, 151002, 151003, 151015, 151016, 200028, 200029

Nghĩa là khi duyệt từ bên trái qua, nếu chuỗi con nào có đủ 6 ký tự thì nó sẽ làm đại diện cho group chuỗi kế tiếp cho đến khi nào gặp chuỗi mới.

Một lần nữa xin cám ơn Bác PTM, NDU, Tuân.
 
Upvote 0
Rất cám ơn các Bác.
Code của ndu là OK rồi, do không mình không nêu rõ điều kiện.
150001-3,15,16,200028-29,,,
thành
150001, 150002, 150003, 150015, 150016, 200028, 200029
Là đáp ứng được yêu cầu.
Bây giờ mình triển khai thêm nhé, mong các Bác hoàn thiện tiếp tục.



Thành



Nghĩa là khi duyệt từ bên trái qua, nếu chuỗi con nào có đủ 6 ký tự thì nó sẽ làm đại diện cho group chuỗi kế tiếp cho đến khi nào gặp chuỗi mới.

Một lần nữa xin cám ơn Bác PTM, NDU, Tuân.
Cùng lắm tôi thêm 1 vòng lập để kiểm tra, phát hiện ra Item nào có len() > 5 thì "tóm cổ" và bắt đầu làm việc từ vị trị này
PHP:
Function ConvertText(Chuoi As String) As String
  Dim Temp As String, Pref As String, i As Long, j As Long, k As Long, Item, Arr
  On Error Resume Next
  Chuoi = WorksheetFunction.Trim(Replace(Replace(Chuoi, " ", ""), ",", " "))
  Arr = Split(Chuoi, " ")
  For Each Item In Arr
    If Len(Item) > 5 Then Exit For
    j = j + 1
  Next Item
  For k = j To UBound(Arr)
    If Len(Arr(k)) > 5 Then Pref = Left(Arr(k), 4)
    If InStr(Arr(k), "-") Then
      For i = Right(Split(Arr(k), "-")(0), 2) To Right(Split(Arr(k), "-")(1), 2)
        Temp = Temp & ", " & Pref & Format(i, "00")
      Next i
    Else
      Temp = Temp & ", " & Pref & Right(Arr(k), 2)
    End If
  Next k
  ConvertText = Mid(Temp, 3, Len(Temp))
End Function
Tạm dùng được nhưng tôi vẫn thấy còn cải tiến thêm được nữa đấy
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Sorry!
Đoạn:
Temp = Temp & ", " & Pref & Right(Arr(k), 2)
phải sửa thành:
Temp = Temp & ", " & Pref & Format(Right(Arr(k), 2), "00")
thì mới đúng (ở trên đã Format rồi mà ở dưới lại quên)
Tôi post lại đây
 

File đính kèm

Upvote 0
Tiếp nữa nhé Bác NDU.
,,,PT0099-101, 150,16,200028-29,,,
thành

PT0099,PT0101,PT0150, PT0016, 200028, 200029
Ie
PT0099-101 thành PT0099,PT0101
Sau dấu "-" là bao nhiêu ký tự thì ta xét chuỗi trước dấu "-" theo len. Và nối vào theo tiêu chuẩn 2 ký đầu và "00000" cho đủ 6 ký tự.

Rất cám ơn. Bài toán đơn giản mà phát sinh nhiều vấn đề ghê.

Tks NDU tôi đã sửa lại code theo ý mình rồi. Xin phép được dùng code này vào công việc.
Công việc cụ thể như sau:
Chi 1.000.000 đ cho những số CT như sau: ,,,PT0099-101, 150,16,200028-29,,, và do lúc nhập không theo chuẩn nào hết nên bấy giờ làm bài toán ngược là chi cho chứng từ nào là bao nhiêu. Cũng vận dụng được đến đâu hay đến đó thôi.
Cám ơn sự giúp đỡ, và xin lỗi vì đã làm phiền.
 
Lần chỉnh sửa cuối:
Upvote 0
Sorry!
Đoạn:
Temp = Temp & ", " & Pref & Right(Arr(k), 2)
phải sửa thành:
Temp = Temp & ", " & Pref & Format(Right(Arr(k), 2), "00")
thì mới đúng (ở trên đã Format rồi mà ở dưới lại quên)
Tôi post lại đây

"00" - Trong trường hợp hợp 4, 3, và 2 chữ số thì sao nhỉ

Code này chỉ đúng với số có 2 chữ số
 
Upvote 0
"00" - Trong trường hợp hợp 4, 3, và 2 chữ số thì sao nhỉ

Code này chỉ đúng với số có 2 chữ số
Thì sửa luôn thành 4 vì 2 số đầu là biến, còn tiếp là 000001-99999.

Right(Split(Arr(k), "-")(0), 3) thành
Right(Split(Arr(k), "-")(0), 4)

Temp = Temp & ", " & Pref & Format(i, "0000")
 
Upvote 0
Hàm: TextFromTo(cText As String [, LengthCode As Long = 0] )

Tuân ơi... Mình không dám nói code của Tuân không hay, nhưng cho dù là áp dụng với các ký tự chử đứng trước (như PT00...) thì mình nghĩ code cũng không đến nổi dài như thế... Cải tiến lại, 1 UDF duy nhất, ngắn cở 1/3 cái trên cũng đã đủ lắm rồi
Mình đang tập tành, có thể ý kiến còn quá chủ quan (do chưa hiểu hết ý đồ của tác giả) nên có gì chưa phải trong phát biểu mong bạn lượng thứ cho
Mình nghĩ vấn đề nằm ở chổ bạn quá cẩn thận trong việc viết code chẳng?

Vâng, đúng là em rất thận trọng trong việc viết code, em cũng cố gắng tìm cách cho ngắn nhưng không được anh à. Tiêu chí viết code của em là
+ An toàn (tính ổn định, lường trước các tình huống <>)
+ Tốc độ (Không để máy tính thừa các phép tính, lãng phí tài nguyên. Không dùng Split niều hơn một lần trên một biến,...)
+ Rõ ràng (Đọc dễ hiểu, không viết gộp nhiều lệnh vào một dòng)
+ Đạt được 3 tiêu chí trên mà code ngắn gọn thì càng tốt. Thường là khó thực hiện vì phải kiểm tra nhiều tình huống.

Vấn đề code dài hay ngắn không quan trọng mà 3 tiêu chí em liệt kê trên mới quan trọng.

Em đã hoàn thành hàm TextFromTo
Cấu trúc hàm:
TextFromTo(cText As String [, LengthCode As Long = 0] )

Khi thực hiện sẽ làm được tất cả các dạng dưới đây:
Dang 1
150001-3,15,16,28-29
KQ: 00150001,00150002,00150003,00150015,00150016,00150028,00150029

15000-3,5-7,14,15-18,19
KQ: 15000,15001,15002,15003,15005,15006,15007,15014,15015,15016,15017,15018,15019

Dạng 2
00000-2,5-7,8,9-12,15
KQ: 00000,00001,00002,00005,00006,00007,00008,00009,00010,00011,00012,00015

Dạng 3
150028-29,150030-2,150033,TT0034-TT0036,38-40
KQ: 150028,150029,150030,150031,150032,150033,TT0034,TT0035,TT0036,TT0038,TT0039,TT0040

Dạng 4
1000-1,KT00-2,150033,M034-M036,37,38-40,42
KQ: 1000,1001,KT00,KT01,KT02,150033,M034,M035,M036,M037,M038,M039,M040,M042

Dạng 5
PT000,1-3,4,14,15-18,19,M
KQ: PT000,PT001,PT002,PT003,PT004,PT014,PT015,PT016,PT017,PT018,PT019,PT00M

Dạng 6
00000000-2,3-5,6,7-9,10
KQ: 00000000,00000001,00000002,00000003,00000004,00000005,00000006,00000007,00000008,00000009,00000010

Dạng 7
T100,1-2,3-5ABC, 6
KQ: T100,T101,T102,T106

Dạng 8
1,, x,aa1001,151001-3, 150,16,200028-29,,,
KQ: aa1001,151001,151002,151003,151150,151016,200028,200029

,,,PT0099-101, 150,16,200028-29,,,
KQ: PT0099,PT0100,PT0101,PT0150,PT0016,200028,200029

Mã:
[COLOR="SeaGreen"]'--------------------------------------------------------------------
'Author: Nguyen Duy Tuan - www.bluesofts.net
'Prototype: [B]TextFromTo(cText As String [, LengthCode As Long = 0] )[/B]
'Purpose:
'cText = "150001-3,15,16,28-29"
'TextFromTo (cText)="150001,150002,150003,150015,150016,150028,150029"
'--------------------------------------------------------------------[/COLOR]
Option Explicit
Dim cFirstValue$, cText1$, lNum&
Function TextFromTo(ByVal cText As String, Optional ByVal LengthCode As Long = 0) As String
    Dim ArrText
    Dim lb&, ub&, I&, P1&
    Dim cFirstValue2$, cTextRet$
    Dim FirstNum&, Allow As Boolean
    
    'cText = "150001-3,15,16,28-29"
    ArrText = Split(cText, ",")
    
    lb = LBound(ArrText, 1)
    ub = UBound(ArrText, 1)
    ArrText(lb) = Trim(ArrText(lb)): ArrText(ub) = Trim(ArrText(ub))
    
    cFirstValue = Trim(ArrText(lb))
    P1 = InStr(cFirstValue, "-")
    
    If P1 > 0 Then cFirstValue = Left$(cFirstValue, P1 - 1)
    
    If Len(cFirstValue) > 0 Then FirstNum = ExtractNum(cFirstValue, lNum)
    If FirstNum > 1 Then
        cText1$ = Left(cFirstValue, FirstNum - 1)
    Else
        cText1$ = ""
    End If
    
    If lb = ub And ArrText(lb) <> "" Then
        TextFromTo = GetText(cFirstValue, cText1, lNum, ArrText(lb), LengthCode)
        Exit Function
    End If

    For I = lb To ub
        ArrText(I) = Trim(ArrText(I))
        Allow = ArrText(I) <> ""
        If LengthCode > 0 And TextFromTo = "" Then
             Allow = Allow And (Len(ArrText(I)) >= LengthCode)
        End If
        
        If Allow Then
            cFirstValue2 = ArrText(I)
            P1 = InStr(cFirstValue2, "-")
            If P1 > 0 Then
                cFirstValue2 = Left$(cFirstValue2, P1 - 1)
                If Len(cFirstValue2) >= Len(cFirstValue) And (cFirstValue2 <> cFirstValue) Then
                    cTextRet = TextFromTo(ArrText(I), LengthCode)
                    GoTo lbTextRet:
                ElseIf LengthCode > 0 And Len(cFirstValue2) >= LengthCode Then
                    cTextRet = TextFromTo(ArrText(I), LengthCode)
                    GoTo lbTextRet:
                End If
            
            End If
            cTextRet = GetText(cFirstValue, cText1, lNum, ArrText(I), LengthCode)
            
lbTextRet:
            If cTextRet <> "" Then
                TextFromTo = TextFromTo & IIf(TextFromTo <> "", ",", "") & cTextRet
            End If
        End If
    Next I
    
End Function
'--------------------------------------------------------------------
Function GetText(ByVal cFirstValue As String, ByVal cFirstText As String, ByVal lNum As Long, ByVal cSubText As String, ByVal LengthCode As Long) As String
    Dim ArrText
    Dim cText$
    Dim I&, lb&, ub&, lNum1&, lNum2&
    Dim nLenthText&
    If LengthCode > 0 Then
        nLenthText = LengthCode
    Else
        nLenthText = Len(cFirstValue)
    End If
    
    ArrText = Split(cSubText, "-")
    
    lb = LBound(ArrText, 1)
    ub = UBound(ArrText, 1)
    ArrText(lb) = Trim(ArrText(lb))
    ArrText(ub) = Trim(ArrText(ub))
    If (ub - lb = 0) Then
        If (ArrText(lb) = cFirstValue) Then
            GetText = Trim(ArrText(lb))
        Else
            If IsNumeric(ArrText(ub)) Then
                lNum2 = CLng(ArrText(ub))
                If lNum2 < lNum Then lNum2 = GetMax(lNum, lNum2)
                GetText = FillName(nLenthText, cFirstText, CStr(lNum2))
            Else
                GetText = FillName(nLenthText, cFirstText, ArrText(ub))
            End If
        End If
        Exit Function
    ElseIf ArrText(lb) = cFirstValue Then
        ExtractNum ArrText(ub), lNum2
        If lNum2 < lNum Then lNum2 = GetMax(lNum, lNum2)
        
        For I = lNum To lNum2
            cText = FillName(nLenthText, cFirstText, CStr(I))
            GetText = GetText & IIf(GetText <> "", ",", "") & cText
        Next I
        Exit Function
    End If
    
    If IsNumeric(ArrText(lb)) Then
        lNum1 = CLng(ArrText(lb))
    End If
    If IsNumeric(ArrText(ub)) Then
        lNum2 = CLng(ArrText(ub))
    End If
    
    If lNum1 < lNum Then lNum1 = GetMax(lNum, lNum1)
    If lNum2 < lNum Then lNum2 = GetMax(lNum, lNum2)
    
    For I = lNum1 To lNum2
        cText = FillName(nLenthText, cFirstText, CStr(I))
        GetText = GetText & IIf(GetText <> "", ",", "") & cText
    Next I
    
End Function
'--------------------------------------------------------------------
Function ExtractNum(ByVal cNum As String, ByRef lNum As Long) As Long
    Dim I&
    If IsNumeric(cNum) Then
        lNum = CLng(cNum)
        GoTo EndFunc:
    End If
    For I = Len(cNum) To 1 Step -1
        If Not IsNumeric(Mid(cNum, I)) Then
            ExtractNum = I
            Exit For
        End If
    Next I
    
    ExtractNum = ExtractNum + 1 'Possition of the first num
    lNum = CLng(Mid(cNum, ExtractNum))
    
EndFunc:
End Function
'--------------------------------------------------------------------
Function GetMax(ByVal lNum As Long, lNum2 As Long) As Long
    Dim nLen&, nLen2&
    nLen = Len(CStr(lNum)): nLen2 = Len(CStr(lNum2))
    If lNum2 < lNum And nLen2 < nLen Then
        GetMax = CLng(Left$(lNum, nLen - nLen2) & lNum2)
    Else
        GetMax = lNum2
    End If
End Function
'--------------------------------------------------------------------
Function FillName(ByVal nLengthText As Long, ByVal Text1 As String, ByVal Text2 As String, Optional ByVal CharToFill As String = "0")
    Dim nLen&
    nLen = Len(Text1) + Len(Text2)
    If nLen < nLengthText Then
        FillName = Text1 & String$(nLengthText - nLen, CharToFill) & Text2
    ElseIf Len(Text2) >= nLengthText Then
        FillName = Text2
    Else
        FillName = Text1 & Text2
    End If
End Function
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Rất cám ơn Tuân, làm quá tổng quát.
Yêu cầu của mình là: biến là 2 ký tự đầu + 4 ký tự kế tiếp = 6
1,, x,aa0001-3,151001-3, 150,16,200028-29,,,
Thì yêu cầu là
aa0001,aa0002,aa0003,151001,151002,151003,151150,151016,200028,200029

Phần aa thiếu 1 ký tự mình tự sửa cũng OK.
Cám ơn nhiều.
Tạm thời sửa UDF của NDU chạy thử. Và test tiếp.
PHP:
Function ConvertText(Chuoi As String) As String
'***NDU96081631-GPE***'
  Dim Temp As String, Pref As String, i As Long, j As Long, k As Long, Item, Arr
  Dim iText1 As String, iText2 As String
  On Error Resume Next
  Chuoi = Trim(Replace(Replace(Chuoi, " ", ""), ",", " "))
  Arr = Split(Chuoi, " ")
  For Each Item In Arr
    If Len(Item) > 5 Then Exit For
    j = j + 1
  Next Item
  For k = j To UBound(Arr)
    If Len(Arr(k)) > 5 Then Pref = Left(Arr(k), 2)
    If InStr(Arr(k), "-") Then
      'kiem tra doan nay'
      iText1 = Right(Split(Arr(k), "-")(0), 4)
      iText2 = Split(Arr(k), "-")(1)
      iText2 = Left(iText1, Len(iText1) - Len(iText2)) & iText2
      For i = iText1 To iText2
       Temp = Temp & ", " & Pref & Format(i, "0000")
      Next i
    Else
      Temp = Temp & ", " & Pref & Format(Right(Arr(k), 4), "0000")
    End If
  Next k
  ConvertText = Mid(Temp, 3, Len(Temp))
End Function
Xin chân thành cám ơn.
 
Upvote 0
PHP:
Function ConvertText(Chuoi As String) As String
'***NDU96081631-GPE***'
  Dim Temp As String, Pref As String, i As Long, j As Long, k As Long, Item, Arr
  Dim iText1 As String, iText2 As String
  On Error Resume Next
  Chuoi = Trim(Replace(Replace(Chuoi, " ", ""), ",", " "))
  Arr = Split(Chuoi, " ")
  For Each Item In Arr
    If Len(Item) > 5 Then Exit For
    j = j + 1
  Next Item
  For k = j To UBound(Arr)
    If Len(Arr(k)) > 5 Then Pref = Left(Arr(k), 2)
    If InStr(Arr(k), "-") Then
      'kiem tra doan nay'
      iText1 = Right(Split(Arr(k), "-")(0), 4)
      iText2 = Split(Arr(k), "-")(1)
      iText2 = Left(iText1, Len(iText1) - Len(iText2)) & iText2
      For i = iText1 To iText2
       Temp = Temp & ", " & Pref & Format(i, "0000")
      Next i
    Else
      Temp = Temp & ", " & Pref & Format(Right(Arr(k), 4), "0000")
    End If
  Next k
  ConvertText = Mid(Temp, 3, Len(Temp))
End Function
Xin chân thành cám ơn.

Hàm của anh NDU96081631 rất ngắn gọn, khi em test trên 8 dạng/trường hợp trên thì bị sai ởi dạng 4, 5, 7 , các dạng còn lại chỉ đúng khi mã là 6 ký tự.
Nếu anh NDU96081631 hoàn thiện thêm thì rất tốt, các thành viên có thêm nhiều ví dụ để tham khảo, có nhiều dạng để áp dụng tổng quát, không chỉ cho nhu cầu anh ThuNghi.
 
Upvote 0
Hàm của anh NDU96081631 rất ngắn gọn, khi em test trên 8 dạng/trường hợp trên thì bị sai ởi dạng 4, 5, 7 , các dạng còn lại chỉ đúng khi mã là 6 ký tự.
Nếu anh NDU96081631 hoàn thiện thêm thì rất tốt, các thành viên có thêm nhiều ví dụ để tham khảo, có nhiều dạng để áp dụng tổng quát, không chỉ cho nhu cầu anh ThuNghi.
Vâng! Tới đây là mình cũng sắp quá tải rồi...
Mình cũng đã nói từ đầu, mình mới tập tành thôi, vã lại yêu cầu của ThuNghi mang tính chuyên ngành gì đó mình chưa thấu hiểu nên cũng không thể lường trước được các trường hợp có thể xảy ra (đối với nhu cầu của người dùng)
Cảm ơn bạn Tuân đã cho mình mở rộng tầm mắt về kỹ thuật xử lý code
 
Upvote 0
V. Tiêu chí viết code của em là
+ An toàn (tính ổn định, lường trước các tình huống <>)
+ Tốc độ (Không để máy tính thừa các phép tính, lãng phí tài nguyên. Không dùng Split niều hơn một lần trên một biến,...)
+ Rõ ràng (Đọc dễ hiểu, không viết gộp nhiều lệnh vào một dòng)
+ Đạt được 3 tiêu chí trên mà code ngắn gọn thì càng tốt. Thường là khó thực hiện vì phải kiểm tra nhiều tình huống.
Vấn đề code dài hay ngắn không quan trọng mà 3 tiêu chí em liệt kê trên mới quan trọng.

Đó thành tiêu chí phần mềm rồi TUÂN ơi,
Còn ở đây là giải pháp
vòng đời của giải pháp có khi ngắn và dùng xử lý tình huống,
vì thế không nên câu nệ trong giải pháp quá?
 
Upvote 0
Đó thành tiêu chí phần mềm rồi TUÂN ơi,
Còn ở đây là giải pháp
vòng đời của giải pháp có khi ngắn và dùng xử lý tình huống,
vì thế không nên câu nệ trong giải pháp quá?

Anh cho đó là giải pháp tạm thời hay là một giải pháp gì đi nữa thì tính an toàn trong giải pháp được đặt lên hàng đầu. Một chương trình đc xây dựng nên bởi hệ thống các thủ tục, hàm, nếu trong mỗi chúng (đặc biệt ở những khâu xử lý quan trọng) chúng ta làm không trọn vẹn (có nghĩa là chưa xử lý đc nhiều tính huống khác) dẫn đến cả một chương trình lỗi.

Cứ hình dung mấy cái chuỗi kia của bác ThuNghi nó được liệt kê thành chứng từ kế toán đó, là tiền, là quan hệ giao dịch của công ty đó. Điều gì xảy ra nếu các chứng từ được chạy hàm thiếu hoặc sai trong khi ta tưởng chạy hàm là đúng?

Ví dụ thứ hai là, em viết hàm để làm số chứng từ tự động (phiếu thu, chi, nhập ,xuất). Bình thường chạy vẫn đúng, sang tháng sau mở quyển chứng từ 2, vẫn nhập số chứng từ đó, chương trình báo lỗi trùng chứng từ không cho nhập (CT1 = CT1->lỗi; quyển 1.CT1 <> quyển 2. CT1). Đó, một hàm thôi sẽ làm hỏng cả một chương trình.

...

Thực sự có rất nhiều tính huống lỗi có thể xảy ra nên việc của người viết mã phải cố gắng làm cẩn thận một cách tối đa.

Thực ra trong công việc em cũng đã từng chịu hậu quả về những việc làm ẩu rồi nên giờ cẩn thận hơn thôi.
 
Upvote 0

Bài viết mới nhất

Back
Top Bottom