Giúp code tách dữ liệu 1 cột thành 2 cột (1 người xem)

[hondacrv2019]

Em cần code tách 1 cột thành 2 cột như hình. Mong các Quý tộc giúp đở. Xin đa tạ cảm ơn các quý tộc, cán bộ trước nhen

 

[saobekhonglac]

View attachment 229027

Em cần code tách 1 cột thành 2 cột như hình. Mong các Quý tộc giúp đở. Xin đa tạ cảm ơn các quý tộc, cán bộ trước nhen

Thử tạm công thức
D2=INDIRECT("A"&ROW(A1)*2)
E2=INDIRECT("A"&(ROW(B2))*2-1)

 

[BuiQuangThuan]

View attachment 229027

Em cần code tách 1 cột thành 2 cột như hình. Mong các Quý tộc giúp đở. Xin đa tạ cảm ơn các quý tộc, cán bộ trước nhen

Sub test()
    Dim i&, lR&, arr(), KQ, a&
    lR = Range("A" & Rows.Count).End(xlUp).Row
    arr = Range("A2:A" & lR).Value
    ReDim KQ(1 To (UBound(arr) / 2), 1 To 2)
    For i = 1 To UBound(arr)
        If IsNumeric(arr(i, 1))  = false Then
            a = a + 1
            KQ(a, 1) = arr(i, 1)
            KQ(a, 2) = arr(i + 1, 1)
        End If
    Next
    Range("C2:d2").Resize(a) = KQ
End Sub

ko biết đúng không nữa

 

[phulien1902]

1 cách khác:

Sub Test()
    With Selection
        .SpecialCells(xlCellTypeConstants, 2).Copy Range("D2")
        .SpecialCells(xlCellTypeConstants, 1).Copy Range("E2")
    End With
    Application.CutCopyMode = False
End Sub

 

[VetMini]

Em cần code tách 1 cột thành 2 cột như hình. Mong các Quý tộc giúp đở. Xin đa tạ cảm ơn các quý tộc, cán bộ trước nhen

Học ở đâu cái từ "quý tộc" vậy?
Quý tộc là bắt nguồn từ dòng họ. Phải biết chọn cửa đầu thai mới được làm quý tộc. Người sinh của khó dẫu có giỏi như thiên tài cũng không tự biến mình thành hàng quý tộc được.

Tạm xếp qua cái vụ từ ngữ. Cái hình trên có 2 nghĩa:
1. tách theo thứ tự, cứ dòng chẵn qua cột 1, dòng lẻ qua cột 2
2. tách theo định dạng, cứ ký tự sang cột 1 và số sang cột 2
Tập ăn nói tiếng VIệt cho rõ.

 

[AutoReply]

Học ở đâu cái từ "quý tộc" vậy?
Quý tộc là bắt nguồn từ dòng họ. Phải biết chọn cửa đầu thai mới được làm quý tộc. Người sinh của khó dẫu có giỏi như thiên tài cũng không tự biến mình thành hàng quý tộc được.

Tạm xếp qua cái vụ từ ngữ. Cái hình trên có 2 nghĩa:
1. tách theo thứ tự, cứ dòng chẵn qua cột 1, dòng lẻ qua cột 2
2. tách theo định dạng, cứ ký tự sang cột 1 và số sang cột 2
Tập ăn nói tiếng VIệt cho rõ.

Có thể không tách theo chữ hoặc dòng đâu à, biết đâu họ muốn căn format chữ lệch trái thì cho vào cột 1, lệch phải cho qua cột 2 đó nha.

 

[VetMini]

Sub test()
    Dim i&, lR&, arr(), KQ, a&
    lR = Range("A" & Rows.Count).End(xlUp).Row
    arr = Range("A2:A" & lR).Value
    ReDim KQ(1 To (UBound(arr) / 2), 1 To 2)
    For i = 1 To UBound(arr)
        If IsNumeric(arr(i, 1))  = false Then
            a = a + 1
            KQ(a, 1) = arr(i, 1)
            KQ(a, 2) = arr(i + 1, 1)
        End If
    Next
    Range("C2:d2").Resize(a) = KQ
End Sub

ko biết đúng không nữa

Code này luộm thuộm:
For i = 1 To UBound(arr)
If IsNumeric(arr(i, 1)) = false Then
a = a + 1
KQ(a, 1) = arr(i, 1)
KQ(a, 2) = arr(i + 1, 1)
End If
Next
Đã làm việc với cả i và i+1 thì vòng lặp phải nhảy bước 2

Và sai:
1. nếu có vài dữ liệu không phải là số đi liên tiếp thì nó chép ra tùm lum hết.
2. nếu có hơn 50% là ký tự thì mảng KQ sẽ bị tràn

Có thể không tách theo chữ hoặc dòng đâu à, biết đâu họ muốn căn format chữ lệch trái thì cho vào cột 1, lệch phải cho qua cột 2 đó nha.

Cứ coi như có 2+ cách đi.
Chung cuộc vẫn là thớt cần tập nói tiếng Việt cho rõ.

 

[BuiQuangThuan]

Code này luộm thuộm:

Hihi. Con tập tọe chú ạ. Khả năng cần học nhiều. Đang theo dõi mà chưa thấy anh chị nào sổ code để xem cách tư duy.
Chứ lúc con viết cũng thấy có vấn đề. Nhưng thấy kết quả giống kia nên đưa tạm lên.

 

[hondacrv2019]

1 cách khác:

Sub Test()
    With Selection
        .SpecialCells(xlCellTypeConstants, 2).Copy Range("D2")
        .SpecialCells(xlCellTypeConstants, 1).Copy Range("E2")
    End With
    Application.CutCopyMode = False
End Sub

Code chạy sai rồi. Ý mình muốn nói dữ liệu mình có thể là số hoặc text tùy ý.

 

[phulien1902]

View attachment 229051
Code chạy sai rồi. Ý mình muốn nói dữ liệu mình có thể là số hoặc text tùy ý.

Bạn thử:

Sub Test2()
    Dim i&, LR&
    LR = Range("A" & Rows.Count).End(3).Row
    For i = 1 To LR Step 2
        Range("A" & i).Resize(2, 1).Copy
        Range("C" & Rows.Count).End(3).Offset(1).PasteSpecial Transpose:=True
    Next
    Application.CutCopyMode = False
End Sub