(Khó) Chuyển DL từ hàng ngang sang cột

[lehue2603]

Kính gửi các bác giúp em !

Em đang có sheet DL thô, nghĩ đủ [IMG]images/smilies/a43.gif[/IMG] cách rồi chưa nghĩ ra làm thế nào để chuyển sang sheet DL mong muốn.
Thực sự bài toán này thật quá khó đối với mình.[IMG]images/smilies/a22.gif[/IMG]

Mong các bác giúp em. em cảm ơn !

View more random threads:

• Bài toán 60 hoa giáp
• Thảo luận, phân tích ưu nhược điểm của công thức mảng, name, VBA, công thức đơn thuần
• Công thức lấy dự liệu 1 cột
• Nhờ giúp: Công thức không tự chạy được?
• Cách lấy nhiều dòng dữ liệu theo 1 điều kiện? Nhờ giúp đỡ.
• Lỗi trả về kết quả khi tính
• Làm sao để rút ngắn công thức
• Hàm if với điều kiện +-
• Lọc nhiều điều kiện
• Liên quan đến hàm index

[Văn Chiến]

Kính gửi các bác giúp em !

Em đang có sheet DL thô, nghĩ đủ [IMG]images/smilies/a43.gif[/IMG] cách rồi chưa nghĩ ra làm thế nào để chuyển sang sheet DL mong muốn.
Thực sự bài toán này thật quá khó đối với mình.[IMG]images/smilies/a22.gif[/IMG]

Mong các bác giúp em. em cảm ơn !

Cái quan trọng nhất là thiết lập form nhập liệu. Qua bài của bạn mới biết thiết lập dữ liệu là quan trọng thế nào, không phải cứ nhập theo sơ thích mà phải dựa vào cách quản lý, cũng như trích xuất dữ liệu sao cho dễ nhất.
Bài của bạn chỉ có thể viết code VBA thui nhé. Mình sẽ giúp bạn khi nào thực sự rảnh.

[seluoncocach]

Mình cũng nghỉ có mỗi cách chạy VBA mới giải quyết được nhưng cũng lực bất tòng tâm à [IMG]images/smilies/a30.gif[/IMG][IMG]images/smilies/a30.gif[/IMG]

[somei00]

Kính gửi các bác giúp em !

Em đang có sheet DL thô, nghĩ đủ [IMG]images/smilies/a43.gif[/IMG] cách rồi chưa nghĩ ra làm thế nào để chuyển sang sheet DL mong muốn.
Thực sự bài toán này thật quá khó đối với mình.[IMG]images/smilies/a22.gif[/IMG]

Mong các bác giúp em. em cảm ơn !

Option Explicit


Public Sub GPE()
Dim sArr, dArr, I As Long, K As Long, Ma As String, MaTen As String, Ten As String
sArr = Sheet1.Range("A4", Sheet1.Range("A65000").End(3)).Resize(, 3).Value
ReDim dArr(1 To UBound(sArr), 1 To 5)
For I = 1 To UBound(sArr)
    If Left(sArr(I, 1), 10) = "1000004001" Then
        Ma = "1000004001"
        MaTen = Mid(sArr(I, 1), 14, InStr(1, sArr(I, 1), "-", 1) - 15)
        Ten = Mid(sArr(I, 1), InStr(1, sArr(I, 1), "-", 1) + 2, Len(sArr(I, 1)))
    Else
        If sArr(I, 2) <> Empty Then
            K = K + 1
            dArr(K, 1) = Ma
            dArr(K, 2) = MaTen
            dArr(K, 3) = Ten
            dArr(K, 4) = sArr(I, 2)
            dArr(K, 5) = sArr(I, 3)
        End If
    End If
Next I
With Sheet2
    .Range("A3:E1000").ClearContents
    .Range("A3").Resize(K, 5) = dArr
End With
End Sub

[hoanghuy200515]

Cảm ơn bác hpkhuong tuy nhiên mình thấy bạn bắt
Left(sArr(I, 1), 10) = "1000004001"

Vậy với DL đầu vào không phải con số ấy mình giải quyết thê nào vậy ạ?

Như file đính kèm nè [IMG]images/smilies/a05.gif[/IMG]

[banlebanbuon]

Cảm ơn bác hpkhuong tuy nhiên mình thấy bạn bắt
Left(sArr(I, 1), 10) = "1000004001"

Vậy với DL đầu vào không phải con số ấy mình giải quyết thê nào vậy ạ?

Như file đính kèm nè [IMG]images/smilies/a05.gif[/IMG]

Bạn cho dữ liệu sao làm vậy chứ...Ai biết bạn ngứa chỗ nào mà khãi???
P/s: Lưu ý lần sau có đưa lên thì làm ơn cho đủ các trường hợp nhé, để người giúp còn nhìn vào đó mà biết quy luật...Nếu cứ như bài #1 thì không có lần thứ 2 nhé...

Option Explicit


Public Sub GPE()
Dim sArr, dArr, I As Long, K As Long, Ma As String, MaTen As String, Ten As String
sArr = Sheet1.Range("A4", Sheet1.Range("A65000").End(3)).Resize(, 3).Value
ReDim dArr(1 To UBound(sArr), 1 To 5)
For I = 1 To UBound(sArr)
    If InStr(1, sArr(I, 1), "|", 1) Then
        Ma = Mid(sArr(I, 1), 1, InStr(1, sArr(I, 1), "|", 1) - 2)
        MaTen = Mid(sArr(I, 1), 14, InStr(1, sArr(I, 1), "-", 1) - 15)
        Ten = Mid(sArr(I, 1), InStr(1, sArr(I, 1), "-", 1) + 2, Len(sArr(I, 1)))
    Else
        If sArr(I, 2) <> Empty Then
            K = K + 1
            dArr(K, 1) = Ma
            dArr(K, 2) = MaTen
            dArr(K, 3) = Ten
            dArr(K, 4) = sArr(I, 2)
            dArr(K, 5) = sArr(I, 3)
        End If
    End If
Next I
With Sheet2
    .Range("A3:E1000").ClearContents
    .Range("A3").Resize(K, 5) = dArr
End With
End Sub

[ken_tt]

Bác xem lại cho em với hình như nó không ra thì phải !
[IMG]images/smilies/a12.gif[/IMG][IMG]images/smilies/a12.gif[/IMG][IMG]images/smilies/a12.gif[/IMG][IMG]images/smilies/a12.gif[/IMG]

bác xem file dưới nhé