[Help] VBA xóa Chữ sau Số (1 người xem)

[ngoctuyen1995]

Thân Chào cả Nhà GPE...!

Em có vấn đề này nhờ các Thầy giúp với ạ.
Hiện tại em có một list công việc: trong đó có một cột A.. bình thường em phải dùng tay để xóa các chữ sau số.. cách này rất mất thời gian cho những list có trên 10.000 cột... Mong cả nhà giúp đỡ em...

Công việc:
Ví dụ: THANG 6.3 BAM xóa thành THANG 6.3
Qui luật của nó là sau số + [khoảng cách] thì xóa tất cả các chữ ở Phía sau nó . Trong File em có làm ví dụ ở cột B ạ
Mong cả nhà giúp đỡ em ạ.! Em cảm ơn ạ.!

 

[PacificPR]

Thân Chào cả Nhà GPE...!

Em có vấn đề này nhờ các Thầy giúp với ạ.
Hiện tại em có một list công việc: trong đó có một cột A.. bình thường em phải dùng tay để xóa các chữ sau số.. cách này rất mất thời gian cho những list có trên 10.000 cột... Mong cả nhà giúp đỡ em...

Công việc:
Ví dụ: THANG 6.3 BAM xóa thành THANG 6.3
Qui luật của nó là sau số + [khoảng cách] thì xóa tất cả các chữ ở Phía sau nó . Trong File em có làm ví dụ ở cột B ạ
Mong cả nhà giúp đỡ em ạ.! Em cảm ơn ạ.!

Bạn thử dùng cái này thử xem sao

Function DelString(str As String)
    Dim mlen As Long, i As Long, x As Long, Str1 As String
If Len(str) = 0 Then Exit Function
str = Trim(str)
mlen = Len(str)
For i = 1 To mlen
    If IsNumeric(Mid(str, i, 1)) Then
        x = i
    End If
Next
Str1 = Mid(str, 1, x)
DelString = Str1
End Function

Công thức B2= =DelString(A2)

 

[huonglien1901]

Bạn thử dùng cái này thử xem sao

Function DelString(str As String)
    Dim mlen As Long, i As Long, x As Long, Str1 As String
If Len(str) = 0 Then Exit Function
str = Trim(str)
mlen = Len(str)
For i = 1 To mlen
    If IsNumeric(Mid(str, i, 1)) Then
        x = i
    End If
Next
Str1 = Mid(str, 1, x)
DelString = Str1
End Function

Công thức B2= =DelString(A2)

Code hay quá bạn ơi!

 

[phulien1902]

Thân Chào cả Nhà GPE...!

Em có vấn đề này nhờ các Thầy giúp với ạ.
Hiện tại em có một list công việc: trong đó có một cột A.. bình thường em phải dùng tay để xóa các chữ sau số.. cách này rất mất thời gian cho những list có trên 10.000 cột... Mong cả nhà giúp đỡ em...

Công việc:
Ví dụ: THANG 6.3 BAM xóa thành THANG 6.3
Qui luật của nó là sau số + [khoảng cách] thì xóa tất cả các chữ ở Phía sau nó . Trong File em có làm ví dụ ở cột B ạ
Mong cả nhà giúp đỡ em ạ.! Em cảm ơn ạ.!

Bạn thử cách này:

Sub abc()
    Dim LR As Long, i As Long
    LR = Range("A" & Rows.Count).End(xlUp).Row
    Columns(1).Copy Columns(4)
    Columns(4).TextToColumns , xlDelimited, , True, False, False, False, True, False
    Columns("E:G").SpecialCells(xlCellTypeConstants, 2).ClearContents
    For i = 1 To LR
        If Not IsNumeric(Cells(i, 4)) Then
            Cells(i, 3) = Cells(i, 4) & " " & Cells(i, 5)
            Else
             Cells(i, 3) = Cells(i, 4)
        End If
    Next i
    Columns("D:G").EntireColumn.Delete
End Sub

 

[befaint]

Bạn thử dùng cái này thử xem sao

Function DelString(str As String)
    Dim mlen As Long, i As Long, x As Long, Str1 As String
If Len(str) = 0 Then Exit Function
str = Trim(str)
mlen = Len(str)
For i = 1 To mlen
    If IsNumeric(Mid(str, i, 1)) Then
        x = i
    End If
Next
Str1 = Mid(str, 1, x)
DelString = Str1
End Function

Công thức B2= =DelString(A2)

Có thể rút gọn ở một số chỗ sau:
- Có thể lược biến mlen (vì gọi một lần), Str1 cũng không cần tới.
- Dòng "str = Trim(str)" cho lên trước dòng "If Len(str) = 0 Then Exit Function"
- For... Next thì duyệt từ phải sang trái để giảm số vòng lặp, thỏa thì thoát vòng lặp.

 

[PacificPR]

Có thể rút gọn ở một số chỗ sau:
- Có thể lược biến mlen (vì gọi một lần), Str1 cũng không cần tới.
- Dòng "str = Trim(str)" cho lên trước dòng "If Len(str) = 0 Then Exit Function"
- For... Next thì duyệt từ phải sang trái để giảm số vòng lặp, thỏa thì thoát vòng lặp.

Dạ vâng. Theo bài này thì nếu duyệt từ phải qua trái thì tốc độ sẽ nhanh hơn . Em cám ơn anh nhiều

 

[VetMini]

Code bài #2 có hiệu nghiệm hay khong còn tuỳ thuộc vào quy luật "abc1" thì gọi là chữ hay số?

"aa bb cc 123 abc1 abc"
Bạn muốn ngắt ở 123 hay abc1?

 

[ngoctuyen1995]

Dạ vâng. Theo bài này thì nếu duyệt từ phải qua trái thì tốc độ sẽ nhanh hơn . Em cám ơn anh nhiều

Em cảm ơn Chị đã giúp đỡ ạ... Code rất hay ạ... Nhưng có một số chỗ thì nó không hiệu quả ạ.. Như trong data em có B3 DONG LAU 9/8 - nếu đúng thì nó chỉ lấy B3 thôi bởi vì trước số 9/8 không có dấu cách ạ... có thể sửa được không ạ...
Mong Chị giúp đỡ

 

[ngoctuyen1995]

Bạn thử cách này:

Sub abc()
    Dim LR As Long, i As Long
    LR = Range("A" & Rows.Count).End(xlUp).Row
    Columns(1).Copy Columns(4)
    Columns(4).TextToColumns , xlDelimited, , True, False, False, False, True, False
    Columns("E:G").SpecialCells(xlCellTypeConstants, 2).ClearContents
    For i = 1 To LR
        If Not IsNumeric(Cells(i, 4)) Then
            Cells(i, 3) = Cells(i, 4) & " " & Cells(i, 5)
            Else
             Cells(i, 3) = Cells(i, 4)
        End If
    Next i
    Columns("D:G").EntireColumn.Delete
End Sub

cảm ơn Thầy đã quan tâm ạ... thay vì dùng sub em muốn dùng hàm cho linh động được không ạ

 

[ngoctuyen1995]

Code bài #2 có hiệu nghiệm hay khong còn tuỳ thuộc vào quy luật "abc1" thì gọi là chữ hay số?

"aa bb cc 123 abc1 abc"
Bạn muốn ngắt ở 123 hay abc1?

Em muốn ngắt tại vị trí 123 ạ... bởi vì em muốn trước Số có khỏang trống thì sẽ xóa hết phía sau ạ

 

[ndu96081631]

Thấy làm bằng công thức cũng xong:

=LEFT(A2,LOOKUP(10^10,FIND(ROW($A$1:$A$10)-1 & " ",A2& " ")))

Hoặc code "tào lao" tí xem:

Function GetSpec(ByVal Text As String) As String
  Dim n As Long, bChk As Boolean
  If Len(Text) Then
    Text = Text & Space(1)
    For n = 1 To Len(Text) - 1
      If Mid(Text, n, 2) Like "# " Then
        bChk = True: Exit For
      End If
    Next
    If bChk Then GetSpec = Left(Text, n)
  End If
End Function

 

[ngoctuyen1995]

Thấy làm bằng công thức cũng xong:

=LEFT(A2,LOOKUP(10^10,FIND(ROW($A$1:$A$10)-1 & " ",A2& " ")))

Hoặc code "tào lao" tí xem:

Function GetSpec(ByVal Text As String) As String
  Dim n As Long, bChk As Boolean
  If Len(Text) Then
    Text = Text & Space(1)
    For n = 1 To Len(Text) - 1
      If Mid(Text, n, 2) Like "# " Then
        bChk = True: Exit For
      End If
    Next
    If bChk Then GetSpec = Left(Text, n)
  End If
End Function

Cảm ơn Thầy ạ.. Công thức cũng không lấy được chữ B3 DONG LAU 9/8 này ạ

 

[ndu96081631]

Cảm ơn Thầy ạ.. Công thức cũng không lấy được chữ B3 DONG LAU 9/8 này ạ

Thì dùng code đi cho khỏe!
Hoặc thay bằng công thức này:

=LEFT(A2,MIN(IFERROR(FIND(ROW($A$1:$A$10)-1&" ",A2&" "),"")))

Ctrl + Shift + Enter

 

[ngoctuyen1995]

Thì dùng code đi cho khỏe!
Hoặc thay bằng công thức này:

=LEFT(A2,MIN(IFERROR(FIND(ROW($A$1:$A$10)-1&" ",A2&" "),"")))

Ctrl + Shift + Enter

Em cảm ơn Thầy ạ! Em làm dùng code ok rồi ạ
Cảm ơn cả Nhà đã giúp đỡ em... Chúc cả nhà sức khỏe và thành công ạ