Tách chuỗi ký tự ra nhiều ô và ghép các ô đã được tách ra từ chuỗi ký tự

zPeterPan · 1/7/21

Em nhờ các thấy cô và các anh chị trên diễn đàn giúp em đoạn code để tách chuỗi gồm 107 ký tự ra 107 ô trên 1 hàng trong sheet1( TachViTri) , và ghép lần lượt từ ký tự từ vị trí 1 đến vị trí 107 trong sheet2(GhepViTri), và khi nhập ngày tại .cell(C1) thì sẽ hiển thị dữ liệu tách trong sheet1(TachViTri).
đoạn code này em chạy thì không tách ra từ ký tự, Không biết sai hay thiếu ở chỗ nào ạ. . .

Mã:

Sub TachSo()
Dim str As String, i As Long, Col As Long
Dim x
    With Sheet1
    .Range("F3:EZ1000000").ClearContents
        For i = 3 To 10000
            str = Cells(i, 3)
                    x = Split(str, "")
                For Col = 0 To UBound(x)
                    .Cells(i, Col + 5) = x(Col)
                Next Col
        Next i
    End With
End Sub

Chữ màu đỏ là em ví dụ ạ. . .

Em xin cảm ơn ạ. . .

Phuocam · 1/7/21

zPeterPan đã viết:
Em nhờ các thấy cô và các anh chị trên diễn đàn giúp em đoạn code để tách chuỗi gồm 107 ký tự ra 107 ô trên 1 hàng trong sheet1( TachViTri) , và ghép lần lượt từ ký tự từ vị trí 1 đến vị trí 107 trong sheet2(GhepViTri), và khi nhập ngày tại .cell(C1) thì sẽ hiển thị dữ liệu tách trong sheet1(TachViTri).
đoạn code này em chạy thì không tách ra từ ký tự, Không biết sai hay thiếu ở chỗ nào ạ. . .

Mã:

Sub TachSo() Dim str As String, i As Long, Col As Long Dim x With Sheet1 .Range("F3:EZ1000000").ClearContents For i = 3 To 10000 str = Cells(i, 3) x = Split(str, "") For Col = 0 To UBound(x) Cells(i, Col + 5) = x(Col) Next Col Next i End With End Sub

View attachment 261631
Chữ màu đỏ là em ví dụ ạ. . .
View attachment 261632
Em xin cảm ơn ạ. . .

Thêm dấu chấm trước Cells thành

.Cells(i, Col + 5) = x(Col)

Mã:

Sub TachSo() Dim str As String, i As Long, Col As Long Dim x With Sheet1 .Range("F3:EZ1000000").ClearContents For i = 3 To 10000 str = .Cells(i, 3) x = Split(str, "") For Col = 0 To UBound(x) .Cells(i, Col + 5) = x(Col) Next Col Next i End With End Sub

zPeterPan · 1/7/21

Phuocam đã viết:

Thêm dấu chấm trước Cells thành

.Cells(i, Col + 5) = x(Col)

Mã:

Sub TachSo() Dim str As String, i As Long, Col As Long Dim x With Sheet1 .Range("F3:EZ1000000").ClearContents For i = 3 To 10000 str = .Cells(i, 3) x = Split(str, "") For Col = 0 To UBound(x) .Cells(i, Col + 5) = x(Col) Next Col Next i End With End Sub

em viết thiếu dấu . nhưng không tách từng ký tự ra ạ. . .

Phuocam · 1/7/21

zPeterPan đã viết:
em viết thiếu dấu . nhưng không tách từng ký tự ra ạ. . .

Xài tạm cái này:

Mã:

Sub TachSo()
Dim str As String, i As Long, Col As Long
Dim x
    With Sheet1
    .Range("F3:EZ1000000").ClearContents
        For i = 3 To 10000
            str = .Cells(i, 3)
            For Col = 1 To Len(str)
                    .Cells(i, Col + 4) = Mid(str, Col, 1)
            Next Col
        Next i
    End With
End Sub

Ba Tê · 1/7/21

zPeterPan đã viết:
Em nhờ các thấy cô và các anh chị trên diễn đàn giúp em đoạn code để tách chuỗi gồm 107 ký tự ra 107 ô trên 1 hàng trong sheet1( TachViTri) , và ghép lần lượt từ ký tự từ vị trí 1 đến vị trí 107 trong sheet2(GhepViTri), và khi nhập ngày tại .cell(C1) thì sẽ hiển thị dữ liệu tách trong sheet1(TachViTri).
đoạn code này em chạy thì không tách ra từ ký tự, Không biết sai hay thiếu ở chỗ nào ạ. . .

Mã:

Sub TachSo() Dim str As String, i As Long, Col As Long Dim x With Sheet1 .Range("F3:EZ1000000").ClearContents For i = 3 To 10000 str = Cells(i, 3) x = Split(str, "") For Col = 0 To UBound(x) .Cells(i, Col + 5) = x(Col) Next Col Next i End With End Sub

View attachment 261631
Chữ màu đỏ là em ví dụ ạ. . .
View attachment 261632
Em xin cảm ơn ạ. . .

Không biết dữ liệu này là gì.
Không hiểu "Trước + Sau", "Ghép Vị trí" là gì.
Bạn tự chỉnh lại trong Sub.

Phuocam · 1/7/21

zPeterPan đã viết:
em viết thiếu dấu . nhưng không tách từng ký tự ra ạ. . .

Mới google được cái này:

Mã:

Sub TachSo_V2()
Dim str As String, i As Long, Col As Long
Dim x
    With Sheet1
    .Range("F3:EZ1000000").ClearContents
        For i = 3 To 10000
            str = StrConv(.Cells(i, 3).Value, vbUnicode)
                    x = Split(str, Chr$(0))
                For Col = 0 To UBound(x)
                    .Cells(i, Col + 5) = x(Col)
                Next Col
        Next i
    End With
End Sub

zPeterPan · 1/7/21

Phuocam đã viết:

Mới google được cái này:

Mã:

Sub TachSo_V2()
Dim str As String, i As Long, Col As Long
Dim x
    With Sheet1
    .Range("F3:EZ1000000").ClearContents
        For i = 3 To 10000
            str = StrConv(.Cells(i, 3).Value, vbUnicode)
                    x = Split(str, Chr$(0))
                For Col = 0 To UBound(x)
                    .Cells(i, Col + 5) = x(Col)
                Next Col
        Next i
    End With
End Sub

Có thể chuyển ("B2:C") thành mảng để chạy nhanh hơn ạ. . . vì nếu xử lý khoảng 20000 dòng thì chờ lâu lắm bác ạ

Bài đã được tự động gộp: 1/7/21

Ba Tê đã viết:
Không biết dữ liệu này là gì.
Không hiểu "Trước + Sau", "Ghép Vị trí" là gì.
Bạn tự chỉnh lại trong Sub.

dạ vâng em cảm ơn thầy Ba Tê nhiều ạ. . .

VetMini · 1/7/21

Phuocam đã viết:

Mới google được cái này:

Mã:

Sub TachSo_V2()
Dim str As String, i As Long, Col As Long
Dim x
    With Sheet1
    .Range("F3:EZ1000000").ClearContents
        For i = 3 To 10000
            str = StrConv(.Cells(i, 3).Value, vbUnicode)
                    x = Split(str, Chr$(0))
                For Col = 0 To UBound(x)
                    .Cells(i, Col + 5) = x(Col)
                Next Col
        Next i
    End With
End Sub

Col = 5
For Each e In Split(StrConv(.Cells(i, 3).Value, vbUnicode), Chr$(0))
.Cells(i, Col) = e
Col = Col + 1
Next Col

zPeterPan · 1/7/21

Ba Tê đã viết:
Không biết dữ liệu này là gì.
Không hiểu "Trước + Sau", "Ghép Vị trí" là gì.
Bạn tự chỉnh lại trong Sub.

Thầy Ba Tê ơi. . . cho em hỏi chút nếu chọn ngày là ngày cuối thì bị báo lỗi Resize ạ

Ba Tê · 1/7/21

zPeterPan đã viết:
Thầy Ba Tê ơi. . . cho em hỏi chút nếu chọn ngày là ngày cuối thì bị báo lỗi Resize ạ
View attachment 261653

Thay Sub cũ thành cái này:

PHP:

Public Sub GPExxx()
Application.ScreenUpdating = False
Dim sArr(), dArr(), tArr(), Tmp As Variant, D As Date
Dim I As Long, J1 As Long, K As Long, J2 As Long, R As Long, R2 As Long, CoLs As Long
CoLs = 107
With Sheets("Tach Vi Tri")
    sArr = .Range("A3", .Range("A3").End(xlDown)).Resize(, 107).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To CoLs)
For I = 1 To R
    Tmp = sArr(I, 3)
    For J1 = 1 To CoLs
        dArr(I, J1) = Mid(sArr(I, 3), J1, 1) * 1
    Next J1
Next I
    .Range("E3").Resize(R, CoLs) = dArr
    CoLs = 111
    R = R + 1
    sArr = .Range("A2").Resize(R, CoLs).Value
    ReDim tArr(1 To 107 ^ 2, 1 To 6)
End With
'======================================================'
With Sheets("Ghep Vi Tri")
    D = .Range("E1").Value
    For I = 2 To R
        If sArr(I, 2) = D Then
            For J1 = 5 To CoLs
                For J2 = 5 To CoLs
                    If J1 <> J2 Then
                        K = K + 1
                        tArr(K, 1) = sArr(1, J1)
                        tArr(K, 2) = sArr(I, J1)
                        tArr(K, 3) = sArr(1, J2)
                        tArr(K, 4) = sArr(I, J2)
                        tArr(K, 5) = tArr(K, 2) + tArr(K, 4)
                        tArr(K, 6) = sArr(1, J1) & ";" & sArr(1, J2)
                    End If
                Next J2
            Next J1
            Exit For
        End If
    Next I
    .Range("I3:N1000000").ClearContents
    If K then .Range("I3").Resize(K, 6) = tArr
End With
End Sub

zPeterPan · 1/7/21

Ba Tê đã viết:

Thay Sub cũ thành cái này:

PHP:

Public Sub GPExxx()
Application.ScreenUpdating = False
Dim sArr(), dArr(), tArr(), Tmp As Variant, D As Date
Dim I As Long, J1 As Long, K As Long, J2 As Long, R As Long, R2 As Long, CoLs As Long
CoLs = 107
With Sheets("Tach Vi Tri")
    sArr = .Range("A3", .Range("A3").End(xlDown)).Resize(, 107).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To CoLs)
For I = 1 To R
    Tmp = sArr(I, 3)
    For J1 = 1 To CoLs
        dArr(I, J1) = Mid(sArr(I, 3), J1, 1) * 1
    Next J1
Next I
    .Range("E3").Resize(R, CoLs) = dArr
    CoLs = 111
    R = R + 1
    sArr = .Range("A2").Resize(R, CoLs).Value
    ReDim tArr(1 To 107 ^ 2, 1 To 6)
End With
'======================================================'
With Sheets("Ghep Vi Tri")
    D = .Range("E1").Value
    For I = 2 To R
        If sArr(I, 2) = D Then
            For J1 = 5 To CoLs
                For J2 = 5 To CoLs
                    If J1 <> J2 Then
                        K = K + 1
                        tArr(K, 1) = sArr(1, J1)
                        tArr(K, 2) = sArr(I, J1)
                        tArr(K, 3) = sArr(1, J2)
                        tArr(K, 4) = sArr(I, J2)
                        tArr(K, 5) = tArr(K, 2) + tArr(K, 4)
                        tArr(K, 6) = sArr(1, J1) & ";" & sArr(1, J2)
                    End If
                Next J2
            Next J1
            Exit For
        End If
    Next I
    .Range("I3:N1000000").ClearContents
    If K then .Range("I3").Resize(K, 6) = tArr
End With
End Sub

Mã:

sArr = .Range("A3", .Range("A3").End(xlDown)).Resize(, 107).Value

nếu em xóa hết cột A thì dòng này báo lỗi . . . em khai báo Resize("") không được ạ. . .vì cột A không cần thiết và do em dùng hàm Len để đếm ký tự trong cột C và quên không xóa ạ

concogia · 1/7/21

zPeterPan đã viết:
Mã:

sArr = .Range("A3", .Range("A3").End(xlDown)).Resize(, 107).Value

nếu em xóa hết cột A thì dòng này báo lỗi . . . em khai báo Resize("") không được ạ. . .vì cột A không cần thiết và do em dùng hàm Len để đếm ký tự trong cột C và quên không xóa ạ

Sửa chỗ này:
sArr = .Range("B3", .Range("B3").End(xlDown)).Resize(, 107).Value
Và chỗ này:
Tmp = sArr(I, 2)
For J1 = 1 To CoLs
dArr(I, J1) = Mid(sArr(I, 2), J1, 1) * 1
Next J1
Ông Ba Tê gán giá trị cho biến Tmp rồi.....hông xài nó. Híc

zPeterPan · 1/7/21

concogia đã viết:
Sửa chỗ này:
sArr = .Range("B3", .Range("B3").End(xlDown)).Resize(, 107).Value
Và chỗ này:
Tmp = sArr(I, 2)
For J1 = 1 To CoLs
dArr(I, J1) = Mid(sArr(I, 2), J1, 1) * 1
Next J1
Ông Ba Tê gán giá trị cho biến Tmp rồi.....hông xài nó. Híc

cảm ơn bác nhiều ạ. . .

Ba Tê · 1/7/21

zPeterPan đã viết:
nếu em xóa hết cột A thì dòng này báo lỗi . . . em khai báo Resize("") không được ạ. . .vì cột A không cần thiết và do em dùng hàm Len để đếm ký tự trong cột C và quên không xóa ạ

Chỉ cần sửa dòng này:
sArr = .Range("A3", .Range("A3").End(xlDown)).Resize(, 107).Value
thành: sArr = .Range("A3", .Range("B3").End(xlDown)).Resize(, 107).Value

concogia đã viết:
Ông Ba Tê gán giá trị cho biến Tmp rồi.....hông xài nó. Híc

Híc!
Định gán vào Tmp nhưng lại "quên xài":
Đúng ra phải là vầy:

PHP:

    For J1 = 1 To CoLs
        dArr(I, J1) = Mid(Tmp, J1, 1) * 1
    Next J1

zPeterPan · 27/7/21

Ba Tê đã viết:
Chỉ cần sửa dòng này:
sArr = .Range("A3", .Range("A3").End(xlDown)).Resize(, 107).Value
thành: sArr = .Range("A3", .Range("B3").End(xlDown)).Resize(, 107).Value

Híc!
Định gán vào Tmp nhưng lại "quên xài":
Đúng ra phải là vầy:

PHP:

For J1 = 1 To CoLs dArr(I, J1) = Mid(Tmp, J1, 1) * 1 Next J1

Bác giúp em với ạ. . . em muốn ghép vị trí từ ngày đến ngày được không ạ. . .

Ba Tê · 27/7/21

zPeterPan đã viết:
Bác giúp em với ạ. . . em muốn ghép vị trí từ ngày đến ngày được không ạ. . .
View attachment 263091

Sao "... em muốn..." thay đổi hoài vậy?

zPeterPan · 27/7/21

Ba Tê đã viết:
Sao "... em muốn..." thay đổi hoài vậy?

Dạ em xin lỗi ạ. . . Do lúc sự kiện lúc làm rồi thì lại thêm ý tưởng mà cùng nội dung mà lập thêm bài viết mới thì sẽ vi phạm nội quy ạ. . .

Ba Tê · 27/7/21

zPeterPan đã viết:
Dạ em xin lỗi ạ. . . Do lúc sự kiện lúc làm rồi thì lại thêm ý tưởng mà cùng nội dung mà lập thêm bài viết mới thì sẽ vi phạm nội quy ạ. . .

Sửa giùm 2 số 31 thành 32 nhé, Có trường hợp tháng có 31 ngày, "em muốn" từ ngày 1 đến 31, kết quả 32 cột)

PHP:

    .Range("A3:A12000").Resize(, 31).ClearContents
    .Range("A3").Resize(107 ^ 2, 31) = tArr

zPeterPan · 27/7/21

Ba Tê đã viết:
Sửa giùm 2 số 31 thành 32 nhé, Có trường hợp tháng có 31 ngày, "em muốn" từ ngày 1 đến 31, kết quả 32 cột)

PHP:

.Range("A3:A12000").Resize(, 31).ClearContents .Range("A3").Resize(107 ^ 2, 31) = tArr

Nếu 365 ngày thì sẽ sửa thành 365 thù kết quả sẽ ra 366 cột đúng không ạ

Ba Tê · 27/7/21

zPeterPan đã viết:
Nếu 365 ngày thì sẽ sửa thành 365 thù kết quả sẽ ra 366 cột đúng không ạ

365 ngày thì sửa thành 366 (365 cột ngày + 1 cột A = 366)
Nhiều tháng thì code sẽ "sai bét". Cho nó vào ngày TBLS.

Tách chuỗi ký tự ra nhiều ô và ghép các ô đã được tách ra từ chuỗi ký tự

Thành viên hoạt động

File đính kèm

Thành viên mới

Thành viên hoạt động

Thành viên mới

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

File đính kèm

Thành viên mới

Thành viên hoạt động

Ăn cùng góc phố

Thành viên hoạt động

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

Thành viên hoạt động

Gội rồi mới Cạo

Thành viên hoạt động

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

Thành viên hoạt động

File đính kèm

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

File đính kèm

Thành viên hoạt động

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

Thành viên hoạt động

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