Tách số và chữ !

[tranviethung]

Mình có file excel tên là File1, cần tách dữ liệu cột H từ H12-H29, như các bạn thấy Dl cột H gồm có cả chữ và số, việc cần làm ở đây là bỏ hết các kí tự là chữ cái và kí tự đặc biệt, chỉ giữ lại số và tách thành 2 cột, ví dụ như 11 MBA, /2000kVA sẽ thành ở cột H sẽ là 11, cột I là 2000, hay 1 bộ &/(600KVAR) thì sẽ là cột H là 1 cột I la 600. Mong các bạn giúp mình viết 1 macro tách cột H thành 2 cột H,I như yêu cầu trên. Mình đang cần gấp mong các bạn giúp mình.
11 MBA, /2000kVA14/ 299015 MBA, (2930kVA)10/37407MBA = 1330 kVA22MBA = 2044,5kVA22MBA = 2044,5kVA1 bộ &/(600KVAR)01 bộ = 6 tụ

File mình đã gửi File11 la file gốc cần tách chữ số ở cột H và File11_ketqua là file sau khi tách ra được, các bạn xem giúp mình nhé!

 

[voda]

Bạn chạy thử đoạn code này:

Sub Tach_so()
Dim i As Integer, j As Integer
Dim t As Byte, m As Byte, dai As Byte
Dim chuoi As String, chu As String, so As String
t = 8
For i = 12 To 30 Step 2
    chuoi = Cells(i, 8) & " "
    dai = Len(chuoi)
      For j = 1 To dai
        chu = Mid(chuoi, j, 1)
           If (Asc(chu) > 47 And Asc(chu) < 58) Or Asc(chu) = 46 Then
              so = so & chu
              m = m + 1
            Else
                If m >= 1 Then
                   Cells(i, t) = so
                   m = 0
                   so = ""
                   t = t + 1
                 End If
             End If
        Next
      t = 8
  Next
End Sub

Lưu Ý: -Viết số lẻ trong dữ liệu gốc phải dùng dấu chấm (.)
- Nếu muốn dùng dấu phẩy (,) để viết số lẻ, các chỗ khác không dùng dấu này và phải chỉnh lại code.
-Bạn xem lại chỗ này cho thống nhất.

 

[tranviethung]

Thanks voda!

Nếu có nhiều sheet trong file thì sẽ phải dùng 1 vòng lặp để xử lý, voda xem hộ mình nhé!

 

[voda]

Đoạn code sau cho phép duyệt qua tất cả các sheet trong file với điều kiện vùng dữ liệu không thay đổi. Và cho phép nhập số lẻ bằng cả dấu chấm và phẩy cũng như hai dấu ấy có thể nằm xen lẫn trong các ký tự chuỗi. Bạn dùng thử.

Sub Tach_so()
Dim i As Integer, j As Integer
Dim t As Byte, m As Byte, dai As Byte
Dim chuoi As String, chu As String, so As String
Dim Mysheet As Worksheet
For Each Mysheet In Worksheets
Mysheet.Activate
t = 8
For i = 14 To 30 Step 2
    chuoi = Cells(i, 8) & " "
    dai = Len(chuoi)
      For j = 1 To dai
        chu = Mid(chuoi, j, 1)
           If (Asc(chu) > 47 And Asc(chu) < 58) Or Asc(chu) = 46 Or Asc(chu) = 44 Then
               If (Asc(chu) = 44 And m = 0) Or (Asc(chu) = 46 And m = 0) Then GoTo boqua
                so = so & chu
              m = m + 1
            Else
boqua:
                If m >= 1 Then
                   Cells(i, t) = so
             If Right(Cells(i, t), 1) = "," Then Cells(i, t) = Mid(Cells(i, t), 1, Len(Cells(i, t)) - 1)
                   Cells(i, t) = Replace(Cells(i, t), ",", ".")
                   m = 0
                   so = ""
                   t = t + 1
                End If
            End If
          Next
      t = 8
  Next
Next
End Sub

 

[tranviethung]

Thanks voda!

Code chạy rất tốt đúng yêu cầu bài toán, cám ơn bạn nhiều nhé. A mình có gửi bài về đánh dấu và chọn sheet bạn có thể xem giúp mình giúp hoàn thiện các yêu cầu thêm được không? mình đang bí quá, hihi giúp mình sớm trong ngay nhé.
Thanks alot!