Chèn thêm khoảng trắng vào chuỗi số

nhapmon · 9/1/13

xin chào mọi người,

tôi có một chuổi số mã sản phẩm do người công nhân gõ vào
'01300031112.(số 1)
tôi muốn tách ra để dể nhìn như sau:
'01 300 03 11 12 (số 2)
do người công nhân khi thì họ nhớ tách ra khi thì không, nên tôi muốn làm cho nó tự động, khi người ta gõ chuổi số (số 1) thì tự nó tách ra (số 2).
trên cùng một cell nha bà con

tks bà con nhiều

Quang_Hải · 9/1/13

nhapmon đã viết:
xin chào mọi người,

tôi có một chuổi số mã sản phẩm do người công nhân gõ vào
'01300031112.(số 1)
tôi muốn tách ra để dể nhìn như sau:
'01 300 03 11 12 (số 2)
do người công nhân khi thì họ nhớ tách ra khi thì không, nên tôi muốn làm cho nó tự động, khi người ta gõ chuổi số (số 1) thì tự nó tách ra (số 2).
trên cùng một cell nha bà con

tks bà con nhiều

Bạn thử code này xem sao

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim i, tam, j
For i = 10 To 1 Step -2
   If i = 4 Then
      i = 3: j = 3
   Else
      j = 2
   End If
   tam = Mid(Target, i, j) & " " & tam
Next
Target = tam
Application.EnableEvents = True
End Sub

nhapmon · 9/1/13

đúng rồi tks anh QuangHai nhiều,
tôi cũng sử dụng worksheet_change
nhưng do thiếu dòng lệnh
Application.EnableEvents = False
nên nó chạy hoài. tks again

thanhlanh · 9/1/13

Thêm một lựa chọn:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False   
    Dim str: str = Format(Target, "00000000000")
    Target.Value = "'" & Mid(str, 1, 2) & " " & Mid(str, 3, 3) & " " & _
                   Mid(str, 6, 2) & " " & Mid(str, 8, 2) & " " & Mid(str, 10, 2)
    Application.EnableEvents = True
End Sub

To QuangHai1969: Có thể bị mất các số 0 đứng trước

VetMini · 10/1/13

Nhỡ người ta nhập vào có khoảng trắng thì sao?

PHP:

Function ChenKhoangTrang(ByVal inPt As String) As String

' hàm chèn khoảng trắng theo đúng vị trí vào một chuỗi '
' 01300031112 --> 01 300 03 11 12 '
' suy ra các vị trí cần chèn khoảng trắng là: 3, 7, 10, 13 '

Dim idxI, idxO As Integer ' biến đếm index cho input và output '
Dim outPt As String ' chuỗi output '
outPt = Space(Application.Max(15, Len(inPt) + 4)) ' chiều dài tối đa output ' 
' tránh trường hợp nếu chuỗi số dài trên 15 ký tự thì hàm sẽ bể '
idxO = 0
' đọc chuỗi input, nếu gặp ký tự không trắng thì chép qua output '
For idxI = 1 To Len(inPt)
    If Mid(inPt, idxI, 1) <> " " Then
        idxO = idxO + 1
        Select Case idxO
          Case 3, 7, 10, 13 ' các vị trí cần chèn khoảng trắng '
            idxO = idxO + 1
        End Select
        Mid(outPt, idxO, 1) = Mid(inPt, idxI, 1) ' chép lại '
    End If
Next idxI
ChenKhoangTrang = Trim(outPt)
End Function

VetMini · 10/1/13

@quanghai1969 + thanhlanh:

Code của các bạn cần thêm phần loại khoảng trắng có sẵn trong chuỗi trước khi bắt đầu tách.

Tôi không hề biện minh cách làm của tôi mới đúng hoặc hay hơn. Tôi chỉ đưa ra một phuonwg pháp khác để sử lý chuỗi: tạo chuỗi trước và thay từng thành phần thay vì làm đến đâu cộng thêm đến đó.

thanhlanh · 10/1/13

VetMini đã viết:
@quanghai1969 + thanhlanh:

Code của các bạn cần thêm phần loại khoảng trắng có sẵn trong chuỗi trước khi bắt đầu tách.

Tôi không hề biện minh cách làm của tôi mới đúng hoặc hay hơn. Tôi chỉ đưa ra một phuonwg pháp khác để sử lý chuỗi: tạo chuỗi trước và thay từng thành phần thay vì làm đến đâu cộng thêm đến đó.

Đừng biến cái đơn giản thành cái phức tạp trừ khi chủ Topic đưa ra yêu cầu cao hơn, cụ thể hơn. Chẳng ai đang gõ phím số lại gõ nhầm qua phím cách. Mà nếu cần thì chỉ thêm một câu để Replace loại nó ra là được.

dhn46 · 10/1/13

Dhn46 có 1 cách mọi người tham khảo (chỉ xét thuật toán không xét tới các yếu tố bắt lỗi, áp dụng cho mã 11 ký tự)

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim s As String
s = Target
If Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
            With CreateObject("vbscript.regexp")
                .Global = True
                .Pattern = "(\d{2})(\d{3})(\d{2})(\d{2})(\d{2})"
                For Each Match In .Execute(s)
                    s = .Replace(s, "$1" & " " & "$2" & " " & "$3" & " " & "$4" & " " & "$5")
                Next
            End With
        Target = s
    Application.EnableEvents = True
End Sub

thanhlanh · 10/1/13

Thậm chí với yêu cầu này chả cần code, chỉ cần Validation và Format lại được việc hơn code, không cho gõ sai, xem file:

Quang_Hải · 10/1/13

dhn46 đã viết:

Dhn46 có 1 cách mọi người tham khảo (chỉ xét thuật toán không xét tới các yếu tố bắt lỗi, áp dụng cho mã 11 ký tự)

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim s As String
s = Target
If Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
            With CreateObject("vbscript.regexp") 
                 .Global = True
                .Pattern = "(\d{2})(\d{3})(\d{2})(\d{2})(\d{2})"
                For Each Match In .Execute(s)
                    s = .Replace(s, "$1" & " " & "$2" & " " & "$3" & " " & "$4" & " " & "$5")
                Next
            End With
        Target = s
    Application.EnableEvents = True
End Sub

Mà sao lại phải dùng For Each ta?
Nếu dùng vòng lặp thì mình mần nó thế này, ứng dụng mấy cái mới học được hôm nay

PHP:

Sub chen()
Dim s As String, Result As String, i As Byte
s = "01234567890"
   With CreateObject("vbscript.regexp")      
      .Pattern = "(\d{2})(\d{3})(\d{2})(\d{2})(\d{2})"
      For i = 1 To 5
         Result = Result & .Replace(s, "$" & i) & Space(1)
      Next
   End With
 MsgBox Result
End Sub

VetMini · 10/1/13

Nếu dùng regex thì chỉ cần mỗi đoạn số đi kèm với nhiều khoảng trắng \s*
Gộp chúng lại với khoảng trắng ở giữa. Xong gọi hàm trim - hàm trim của WorksheetFunction có khả năng túm nhiều khoảng trắng lại thành 1.

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim mc as object

If Target.Count > 1 Then Exit Sub
    Application.EnableEvents = False
            With CreateObject("vbscript.regexp")
                .Global = True
                .Pattern = "(\d{2}\s*)(\d{3}\s*)(\d{2}\s*)(\d{2}\s*)(\d{2}\s*)"
                Set mc = .Execute(Target.Value)
                Target = Application.WorksheetFunction.Trim( _
                     mc(0).submatches(0) & " " & _
                     mc(0).submatches(1) & " " & _
                     mc(0).submatches(2) & " " & _
                     mc(0).submatches(3) & " " & _
                     mc(0).submatches(4))
            End With
    Application.EnableEvents = True
End Sub

siwtom · 11/1/13

VetMini đã viết:
Nếu dùng regex thì chỉ cần mỗi đoạn số đi kèm với nhiều khoảng trắng \s*
Gộp chúng lại với khoảng trắng ở giữa. Xong gọi hàm trim - hàm trim của WorksheetFunction có khả năng túm nhiều khoảng trắng lại thành 1.

Mã:

Private Sub Worksheet_Change(ByVal Target As Range) Dim mc as object If Target.Count > 1 Then Exit Sub Application.EnableEvents = False With CreateObject("vbscript.regexp") .Global = True .Pattern = "(\d{2}\s*)(\d{3}\s*)(\d{2}\s*)(\d{2}\s*)(\d{2}\s*)" Set mc = .Execute(Target.Value) Target = Application.WorksheetFunction.Trim( _ mc(0).submatches(0) & " " & _ mc(0).submatches(1) & " " & _ mc(0).submatches(2) & " " & _ mc(0).submatches(3) & " " & _ mc(0).submatches(4)) End With Application.EnableEvents = True End Sub

Code có vài vấn đề.
Chủ topic có những người công nhân "bình thường"
Trích:

do người công nhân khi thì họ nhớ tách ra khi thì không

Họ bình thường vì họ cũng chỉ là con người chứ không phải cái máy. Thậm chí máy còn bị hỏng hóc.
Người công nhân có thể quên, có thể mệt mỏi lơ đãng dẫn đến sai sót. Code cần phải giúp họ sửa lỗi, nhắc nhở.
Nếu với code trên người công nhân gõ 10 hoặc < 10 ký tự thì "toi". Ta bỏ qua trường hợp khi chuỗi có ký tự không là chữ số vì tuy có thể sẩy ra nhưng xác suất không cao.

Mà không có kiểu bẫy lỗi để "lờ đi" (On Error Resume Next) đâu nhé. Dữ liệu sai thì phải bắt nhập lại chứ không thể chấp nhận kiểu Resume Next hay Exit Sub.

Mà không biết code định lấy mấy kết quả mà thay mặc định thành ".Global = True"?
Để lấy 2 kết quả thì phải gõ ít nhất 22 chữ số.

Thế nếu người công nhân gõ gần đúng với yêu cầu của cậu chủ / cô chủ, chỉ nhầm một tí, vd. gõ:
"123 45 67 89 55"

Thì sao?

Thì code cũng tèo. Dạng trên có thể có nhiều biến tấu vd. "12 34 567 89 55"
-----------------
Đã mất công vào xem mọi người "diễn" thì cũng góp vui chút bằng code "quái đản"

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim s As String
    If Target.Count > 1 Then Exit Sub   ' hoac xu ly theo de nghi cua chu topic
    s = Replace(Application.WorksheetFunction.Trim(Target), " ", vbNullString)
    Application.EnableEvents = False
    If Len(s) <> 11 Or Not IsNumeric(s) Then
        MsgBox "Hay nhap dung 11 chu so"
        Target = vbNullString
    Else
        With CreateObject("vbscript.regexp")
            .Global = True
            .Pattern = "\B(?=([COLOR=#ff0000]?:[/COLOR]\d{9}|\d{6}|\d{4}|\d{2})$)"     '  hoac "\B(?=(\d{9}|\d{6}|\d{4}|\d{2})$)"
            Target = .Replace(s, " ")
        End With
    End If
    Application.EnableEvents = True
End Sub

nhapmon · 11/1/13

rất cám ơn thầy vì những góp ý quý giá. vì thầy đứng ở vị trí của người lập trình nên lường được mọi khả năng có thể xảy ra khi sử dụng. giống như microsoft vậy khi họ tung sản phẩm của họ ra thì cho cả mấy tỉ con người thay hồ mà dzọc.
trong môi trường nhỏ này thì chỉ cần thông báo cho người công nhân biết là các anh cứ việc gõ vào không cần khoảng trắng nó sẻ tự tách ra, càng ít việc họ càng khoái...hihihi

một lần nữa, cám ơn thầy.

siwtom · 11/1/13

quanghai1969 đã viết:
Mà sao lại phải dùng For Each ta?
Nếu dùng vòng lặp thì mình mần nó thế này, ứng dụng mấy cái mới học được hôm nay

PHP:

Sub chen() Dim s As String, Result As String, i As Byte s = "01234567890" With CreateObject("vbscript.regexp") .Pattern = "(\d{2})(\d{3})(\d{2})(\d{2})(\d{2})" For i = 1 To 5 Result = Result & .Replace(s, "$" & i) & Space(1) Next End With MsgBox Result End Sub

Nếu là "nối các $ thì không cần nhọc công thế đâu Hải ạ.

"củ chuối" thì là: Result = .Replace(s, "$1 " & "$2 " & "$3 " & "$4 " & "$5")

Nhưng gọn, đẹp là:

[GPECODE=vb]
Sub chen()
Dim s As String, Result As String, i As Byte
s = "01234567890"
With CreateObject("vbscript.regexp")
.Pattern = "(\d{2})(\d{3})(\d{2})(\d{2})(\d{2})"
Result = .Replace(s, "$1 $2 $3 $4 $5")
End With
MsgBox Result
End Sub
[/GPECODE]

Ngoài ra chả lý gì lại gọi phương thức Replace 5 lần

Quang_Hải · 11/1/13

siwtom đã viết:
Nếu là "nối các $ thì không cần nhọc công thế đâu Hải ạ.

"củ chuối" thì là: Result = .Replace(s, "$1 " & "$2 " & "$3 " & "$4 " & "$5")

Nhưng gọn, đẹp là:

[GPECODE=vb]
Sub chen()
Dim s As String, Result As String, i As Byte
s = "01234567890"
With CreateObject("vbscript.regexp")
.Pattern = "(\d{2})(\d{3})(\d{2})(\d{2})(\d{2})"
Result = .Replace(s, "$1 $2 $3 $4 $5")
End With
MsgBox Result
End Sub
[/GPECODE]

Ngoài ra chả lý gì lại gọi phương thức Replace 5 lần

Nói về Regexp thì chiêu nào của anh tung ra cũng đáng nể. Nếu chưa thấy cách anh chèn khoảng trắng thế này thì không thể nghĩ ra. Nhưng giờ thì nhớ rõ rồi. Cảm ơn anh.

VetMini · 11/1/13

@siwtom

Nóí chuyện regex chơi cho vui thôi. Bài này đã giải rồi.
Lúc đưa code trên ra tôi chỉ cóp lại code của Dhn46 với mục đích nói về cách nối chuỗi không qua replace. Trong code của Dhn46, bạn này có nói rõ "chỉ xét thuật toán không xét tới các yếu tố bắt lỗi"

Về vấn đề ?: và ?=

Tuy mấy cái này rất tốt nhưng trong lúc chơi regex với vbscript tôi hơi ngại mấy cái vụ non-capturing group và lookaround vì có những cái nó không chịu hổ trợ. Dùng submatches đỡ mất công đau đầu.

siwtom · 11/1/13

VetMini đã viết:
@siwtom

Về vấn đề ?: và ?=

Tuy mấy cái này rất tốt nhưng trong lúc chơi regex với vbscript tôi hơi ngại mấy cái vụ non-capturing group và lookaround vì có những cái nó không chịu hổ trợ. Dùng submatches đỡ mất công đau đầu.

?: và ?= thì có liên quan gì tới submatches? Trong pattern có thể có cấu trúc với (?=) mà chả có "nhớ nhung" với SubMatches gì cả.

Tất nhiên Microsoft VBScript Regular Expression "nghèo nàn" hơn là trong những ngôn ngữ khác. Nhưng chịu khó học để biết nó có những gì để mà sử dụng thì vẫn hay hơn

siwtom · 11/1/13

quanghai1969 đã viết:
Nói về Regexp thì chiêu nào của anh tung ra cũng đáng nể. Nếu chưa thấy cách anh chèn khoảng trắng thế này thì không thể nghĩ ra. Nhưng giờ thì nhớ rõ rồi. Cảm ơn anh.

Ta chỉ cần nhớ:

1. Dạng thông số thứ 2 là tùy ý, tùy nhu cầu của ta. Vd.

Mã:

Result = .Replace(s, "Cho nay cha dung gi toi cac doan nho")

2. Nếu có những đoạn nhớ thì có thể dùng nếu muốn. Không nhất thiết phải dùng tất cả các đoạn và mỗi đoạn có thể dùng nhiều lần.

3. Nếu là số cụ thể thì luôn có thể viết gọn là $1, $2, ..., $99
Nhưng nếu là ẩn, thông số truyền vào, vd. index thì rõ ràng không thể viết "$index" được nên phải dùng "$" & index

4. Mỗi kết quả tìm được - tức khớp với pattern - có các đoạn nhớ tương ứng với nó.

[GPECODE=vb]
Sub chen()
Dim s As String, Result As String, i As Byte
s = "01234567890"
With CreateObject("vbscript.regexp")
.Pattern = "(\d{2})(\d{3})(\d{2})(\d{2})(\d{2})"
Result = .Replace(s, "O cuoc thi no $4 thi sinh da an $2 bat pho, va $4$3 xuc xich, uong $3$1 ken - nhau voi $1$5,$4 kg thit bo")
End With
MsgBox Result
End Sub
[/GPECODE]

VetMini · 11/1/13

"?:" là non-capture, có thể coi như là tiêu chuẩn, không có gì đáng sợ.

"?=" là lookahead, không hẳn regex engine nào cũng hổ trợ. VBScript có hổ trợ.

Điểm làm tôi bực mình là cái thằng đi cặp với nó, thằng lookbehind "?<=" thì VBScript lại không chịu hổ trợ. Điều này làm lắm lúc mình nghiên cứu pattern đã rồi luc nhét vào lại không chịu chạy. Mất công nghiên cứu lại.

Vì vậy mấy thằng lười như tôi tránh hẳn mấy cái lookaround ra và dùng submatches để giải quyết.

siwtom · 11/1/13

VetMini đã viết:
"?:" là non-capture, có thể coi như là tiêu chuẩn, không có gì đáng sợ.

"?=" là lookahead, không hẳn regex engine nào cũng hổ trợ. VBScript có hổ trợ.

Điểm làm tôi bực mình là cái thằng đi cặp với nó, thằng lookbehind "?<=" thì VBScript lại không chịu hổ trợ. Điều này làm lắm lúc mình nghiên cứu pattern đã rồi luc nhét vào lại không chịu chạy. Mất công nghiên cứu lại.

Vì vậy mấy thằng lười như tôi tránh hẳn mấy cái lookaround ra và dùng submatches để giải quyết.

Tôi thì bực mình vì có vài cấu trúc nữa có trong các ngôn ngữ script nhưng trong M. VBScript Exp. không hỗ trợ. vd. như "?<=" bạn nêu ở trên. Mất công thì cũng chả quan trọng. Mà cái biết thêm có thể lúc nào đó sẽ cần khi làm việc với ngôn ngữ khác. Nguyên lý thì tương tự nhau mà.
Cái bực nhất là không dùng được để đơn giản một số trường hợp.

Chèn thêm khoảng trắng vào chuỗi số

Thành viên tích cực

Thành viên gạo cội

Thành viên tích cực

Thành viên tích cực

Ăn cùng góc phố

Ăn cùng góc phố

Thành viên tích cực

Hướng tới tương lai

Thành viên tích cực

File đính kèm

Thành viên gạo cội

Ăn cùng góc phố

Thành viên gắn bó

Thành viên tích cực

Thành viên gắn bó

Thành viên gạo cội

Ăn cùng góc phố

Thành viên gắn bó

Thành viên gắn bó

Ăn cùng góc phố

Thành viên gắn bó

Đếm ngược thời gian