Tách giúp các số hạng trong chuỗi chứa các kí số vô các ô; như ["101","112","108"] => 101, 112, 108

alihung · 8/5/18

ô A2 có chuỗi ["106","107","108","109","112"]
Mọi người giúp em tách chuỗi trên thành
ô A3 106
ô A4 107
ô A5 108
ô A6 109
ô A7 112

Em có file đính kèm mô tả rõ hơn.
Em cảm ơn anh chị ạh.

Hoang2013 · 8/5/18

Tiêu đề bài viết của bạn đang fạm qui; Hãy sữa lại mới có người giúp bạn.

Mình đề xuất tiêu đề: "Tách giúp các số hạng trong chuỗi chứa các kí số vô các ô; như ["101","112","108"] => 101, 112, 108

phihndhsp · 8/5/18

alihung đã viết:
ô A2 có chuỗi ["106","107","108","109","112"]
Mọi người giúp em tách chuỗi trên thành
ô A3 106
ô A4 107
ô A5 108
ô A6 109
ô A7 112

Em có file đính kèm mô tả rõ hơn.
Em cảm ơn anh chị ạh.

Theo cách bố trí như vậy thì thử làm vầy xem sao

alihung · 8/5/18

phihndhsp đã viết:
Theo cách bố trí như vậy thì thử làm vầy xem sao

Cảm ơn bạn nhiều nhé.

be_09 · 8/5/18

alihung đã viết:
ô A2 có chuỗi ["106","107","108","109","112"]
Mọi người giúp em tách chuỗi trên thành
ô A3 106
ô A4 107
ô A5 108
ô A6 109
ô A7 112

Em có file đính kèm mô tả rõ hơn.
Em cảm ơn anh chị ạh.

Nên tách sang cột B, C, D, ...v..v.....
Vì thực tế không phải có 1 dãy số ở A2 mà có thể là A3: A500 (chẳng hạn).

ndu96081631 · 8/5/18

phihndhsp đã viết:
Theo cách bố trí như vậy thì thử làm vầy xem sao

Công thức của bạn:

Mã:

=MID(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE($A2, CHAR(34),""),"[",""),"]",""),",",""),(COLUMNS($A:A)-1)*3+1,3)

Là vì bạn nghĩ chuỗi luôn =3 ký tự?
Nếu đã vậy thì thôi thà đơn giản hơn:

Mã:

=MID($A2,(COLUMNS($A:A)-1)*6+3,3)

HieuCD · 8/5/18

alihung đã viết:
ô A2 có chuỗi ["106","107","108","109","112"]
Mọi người giúp em tách chuỗi trên thành
ô A3 106
ô A4 107
ô A5 108
ô A6 109
ô A7 112

Em có file đính kèm mô tả rõ hơn.
Em cảm ơn anh chị ạh.

Dùng hàm Mid và column

phulien1902 · 8/5/18

alihung đã viết:
ô A2 có chuỗi ["106","107","108","109","112"]
Mọi người giúp em tách chuỗi trên thành
ô A3 106
ô A4 107
ô A5 108
ô A6 109
ô A7 112

Em có file đính kèm mô tả rõ hơn.
Em cảm ơn anh chị ạh.

Bạn thử:

PHP:

Sub abc()
    Dim LR, LC, i As Long, j As Long, St As String, Sp
    Application.ScreenUpdating = False
    LR = Cells(Rows.Count, 1).End(3).Row
    LC = Range("IV1").End(xlToLeft).Column
    For i = 2 To LR
        St = Cells(i, 1)
        Sp = Split(St, ",")
        For j = LBound(Sp) To UBound(Sp)
            Cells(i, j + 2) = Sp(j)
        Next
    Next
    For j = 2 To LC
        With Columns(j)
            .Replace "[", ""
            .Replace "]", ""
            .Replace """", " "
        End With
    Next
    Application.ScreenUpdating = True
End Sub

ndu96081631 · 8/5/18

phulien1902 đã viết:

Bạn thử:

PHP:

Sub abc()
    Dim LR, LC, i As Long, j As Long, St As String, Sp
    Application.ScreenUpdating = False
    LR = Cells(Rows.Count, 1).End(3).Row
    LC = Range("IV1").End(xlToLeft).Column
    For i = 2 To LR
        St = Cells(i, 1)
        Sp = Split(St, ",")
        For j = LBound(Sp) To UBound(Sp)
            Cells(i, j + 2) = Sp(j)
        Next
    Next
    For j = 2 To LC
        With Columns(j)
            .Replace "[", ""
            .Replace "]", ""
            .Replace """", " "
        End With
    Next
    Application.ScreenUpdating = True
End Sub

Code 3 vòng lập? Vậy có thể rút xuống còn 2, thậm chí 1 vòng lập được không?

phulien1902 · 8/5/18

ndu96081631 đã viết:
Code 3 vòng lập? Vậy có thể rút xuống còn 2, thậm chí 1 vòng lập được không?

Em mới rút gọn được 1 vòng For thôi anh à:

PHP:

Sub abc2()
    Dim LR, LC, i As Long, j As Long, St As String, Sp
    Application.ScreenUpdating = False
    LR = Cells(Rows.Count, 1).End(3).Row
    LC = Range("IV1").End(xlToLeft).Column
    For i = 2 To LR
        St = Cells(i, 1)
        Sp = Split(St, ",")
        For j = LBound(Sp) To UBound(Sp)
            Cells(i, j + 2) = Sp(j)
            With Cells(i, j + 2)
                .Replace "[", ""
                .Replace "]", ""
                .Replace """", " "
            End With
        Next
    Next
Application.ScreenUpdating = True
End Sub

phihndhsp · 8/5/18

phulien1902 đã viết:

Em mới rút gọn được 1 vòng For thôi anh à:

PHP:

Sub abc2()
    Dim LR, LC, i As Long, j As Long, St As String, Sp
    Application.ScreenUpdating = False
    LR = Cells(Rows.Count, 1).End(3).Row
    LC = Range("IV1").End(xlToLeft).Column
    For i = 2 To LR
        St = Cells(i, 1)
        Sp = Split(St, ",")
        For j = LBound(Sp) To UBound(Sp)
            Cells(i, j + 2) = Sp(j)
            With Cells(i, j + 2)
                .Replace "[", ""
                .Replace "]", ""
                .Replace """", " "
            End With
        Next
    Next
Application.ScreenUpdating = True
End Sub

Sub abc2()
Dim LR, LC, i As Long, j As Long, St As String, Sp
Dim Cll As Range
Application.ScreenUpdating = False
LR = Cells(Rows.Count, 1).End(3).Row
LC = Range("IV1").End(xlToLeft).Column
For i = 2 To LR
Set Cll = Cells(i, 1)
Cll.Replace "[", ""
Cll.Replace "]", ""
Cll.Replace """", " "
Sp = Split(Cll, ",")
Range("b2").Offset(i - 3 + 1, 0).Resize(1, UBound(Sp, 1) + 1) = Sp
Next
Application.ScreenUpdating = True
End Sub
Anh có thể theo hướng này xem sao. Code này là của anh tôi có chỉnh 1 tí

phulien1902 · 8/5/18

phihndhsp đã viết:
Sub abc2()
Dim LR, LC, i As Long, j As Long, St As String, Sp
Dim Cll As Range
Application.ScreenUpdating = False
LR = Cells(Rows.Count, 1).End(3).Row
LC = Range("IV1").End(xlToLeft).Column
For i = 2 To LR
Set Cll = Cells(i, 1)
Cll.Replace "[", ""
Cll.Replace "]", ""
Cll.Replace """", " "
Sp = Split(Cll, ",")
Range("b2").Offset(i - 3 + 1, 0).Resize(1, UBound(Sp, 1) + 1) = Sp
Next
Application.ScreenUpdating = True
End Sub
Anh có thể theo hướng này xem sao. Code này là của anh tôi có chỉnh 1 tí

Bạn sửa như vậy là chưa ổn? Vì không còn giá trị gốc( cột A) ban đầu.

HieuCD · 8/5/18

ndu96081631 đã viết:
Code 3 vòng lập? Vậy có thể rút xuống còn 2, thậm chí 1 vòng lập được không?

Không cần vòng For

Mã:

Sub abc()
    Dim eR As Long
    Application.ScreenUpdating = False
    eR = Cells(Rows.Count, 1).End(3).Row
    Range("B2").Resize(eR - 1, 50).FormulaR1C1 = "=MID(RC1,COLUMN(R1C[-1])*6-3,3)"
    Range("B2").Resize(eR - 1, 50).Value = Range("B2").Resize(eR - 1, 50).Value
    Application.ScreenUpdating = True
End Sub

ndu96081631 · 8/5/18

phulien1902 đã viết:

Em mới rút gọn được 1 vòng For thôi anh à:

PHP:

Sub abc2()
    Dim LR, LC, i As Long, j As Long, St As String, Sp
    Application.ScreenUpdating = False
    LR = Cells(Rows.Count, 1).End(3).Row
    LC = Range("IV1").End(xlToLeft).Column
    For i = 2 To LR
        St = Cells(i, 1)
        Sp = Split(St, ",")
        For j = LBound(Sp) To UBound(Sp)
            Cells(i, j + 2) = Sp(j)
            With Cells(i, j + 2)
                .Replace "[", ""
                .Replace "]", ""
                .Replace """", " "
            End With
        Next
    Next
Application.ScreenUpdating = True
End Sub

Ý tôi là vầy:

Mã:

Sub abc2()
  Dim lCs, lCMax As Long, arr, cel As Range
  With Range("A2", Range("A60000").End(xlUp))
    For Each cel In .Cells
      arr = Split(cel.Value, ",")
      lCs = UBound(arr) + 1
      If lCMax < lCs Then lCMax = lCs
      cel.Offset(, 1).Resize(, lCs).Value = arr
    Next
    With .Offset(, 1).Resize(, lCMax)
      .Replace "[", ""
      .Replace """", ""
      .Replace "]", ""
    End With
  End With
End Sub

Bởi vì:
- Split xong có thể gán luôn xuống sheet mà không cần vòng lập
- Có thể replace cả vùng mà không cần vòng lập
----------------
còn việc gán công thức trực tiếp xuống sheet thì ta không bàn tới

phihndhsp · 8/5/18

phulien1902 đã viết:
Bạn sửa như vậy là chưa ổn? Vì không còn giá trị gốc( cột A) ban đầu.

mình có thể tùy chỉnh lại, ý tường là như vậy, khi thực hiện mình có thể tinh chỉnh lại, thay vì sử dụng replace trong excel thì sử dụng hàm replace trong vba, chỉnh lại cái cll kiểu chuỗi là ok

Ba Tê · 8/5/18

alihung đã viết:
ô A2 có chuỗi ["106","107","108","109","112"]
Mọi người giúp em tách chuỗi trên thành
ô A3 106
ô A4 107
ô A5 108
ô A6 109
ô A7 112

Em có file đính kèm mô tả rõ hơn.
Em cảm ơn anh chị ạh.

Sử dụng công cụ của anh Bill:

PHP:

Public Sub GPE_Tach()
Dim R As Long
R = Range("A2", Range("A50000").End(xlUp)).Rows.Count
With Range("B2").Resize(R)
    .Value = Range("A2").Resize(R).Value
    .Replace "[", ""
    .Replace "]", ""
    .TextToColumns Destination:=Range("B2"), DataType:=xlDelimited, OtherChar:=","
End With
End Sub

be_09 · 8/5/18

Thêm 1 cách khác:

Mã:

Sub Tach_Chuoi()
    Sheet1.Range("D2").CurrentRegion.ClearContents
    Range("A2", Range("A65536").End(xlUp)).TextToColumns Destination:=Range("D2"), _
        DataType:=xlDelimited, Comma:=True, OtherChar:=","
    With Range("D2").CurrentRegion
        .Replace "[", ""
        .Replace "]", ""
        .Replace """", ""
    End With
End Sub

phulien1902 · 8/5/18

be09 đã viết:

Thêm 1 cách khác:

Mã:

Sub TachChuoi()
    Dim Vung, Thay As Range

    Range("B2:M200").ClearContents
    Set Vung = Sheet1.Range("B2:B200")
    Set Thay = Sheet1.Range("B2:M200")
 
    Vung.Value = Sheet1.Range("A2:A200").Value
    Vung.TextToColumns DataType:=xlDelimited, comma:=True, OtherChar:=","

    With Thay
        .Replace "[", ""
        .Replace "]", ""
        .Replace """", ""
    End With

End Sub

Code của bác còn thiếu 2 dòng này:

PHP:

Application.ScreenUpdating = False
'---------------------
Application.ScreenUpdating = true

be_09 · 8/5/18

phulien1902 đã viết:
Code của bác còn thiếu 2 dòng này:

PHP:

Application.ScreenUpdating = False '--------------------- Application.ScreenUpdating = true

2 dòng này dùng để tránh giựt màn hình, khi nào dữ liệu nhiều mới dùng đến nó, code trên có 200 dòng nên cũng không cần.

ndu96081631 · 8/5/18

Ba Tê đã viết:

Sử dụng công cụ của anh Bill:

PHP:

Public Sub GPE_Tach()
Dim R As Long
R = Range("A2", Range("A50000").End(xlUp)).Rows.Count
With Range("B2").Resize(R)
    .Value = Range("A2").Resize(R).Value
    .Replace "[", ""
    .Replace "]", ""
    .TextToColumns Destination:=Range("B2"), DataType:=xlDelimited, OtherChar:=","
End With
End Sub

Đây là cách ngon nhất, bởi có thể dùng code hoặc thậm chí làm bằng tay cũng chỉ mất 30s
Công cụ của anh Bill luôn mạnh, chính xác và ổn nhất

Tách giúp các số hạng trong chuỗi chứa các kí số vô các ô; như ["101","112","108"] => 101, 112, 108

Thành viên mới

File đính kèm

Thành viên gắn bó

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

File đính kèm

Thành viên mới

Biên Hòa, Đồng Nai

Huyền thoại GPE

Chuyên gia GPE

File đính kèm

GPE - My love

Huyền thoại GPE

GPE - My love

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

GPE - My love

Chuyên gia GPE

Huyền thoại GPE

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

Cạo Rồi Khỏi Gội

File đính kèm

Biên Hòa, Đồng Nai

File đính kèm

GPE - My love

Biên Hòa, Đồng Nai

Huyền thoại GPE

Facebook

Group