Nhờ hoàn thiện code: Sắp xếp bảng dữ liệu nhiều cột thành 3 cột, bỏ qua ô trống (1 người xem)

[bebo021999]

Buồn buồn viết thử, sao thấy củ chuối quá. Mọi người sửa giúp một số vấn đề:

Yêu cầu:

-Sắp xếp lại bảng nhiều cột thành 3 cột theo đề mục
-Bỏ qua các ô trống
Hiện code củ chuối của mình chưa xác định được vùng động cho Part 1 và Part 2

Bài gốc tại đây: http://www.excelforum.com/showthread.php?t=1150742&p=4451112#post4451112

Sub sd()
Dim ArrP1(), ArrP2(), List1(), List2(), a As Variant
Dim sArr, dArr As String
ReDim ArrP1(1 To 4, 1 To 5)
ReDim ArrP2(1 To 4, 1 To 5)
Dim i, j, k
[G3:I100].ClearContents
ArrP1 = Range("A4:E7")
ArrP2 = Range("A11:E14")
For j = 1 To 5
    For i = 1 To 4
        If ArrP1(i, j) = "" Then Exit For
        sArr = ArrP1(i, j) & "|"
        dArr = dArr & sArr
        k = Len(dArr) - Len(Replace(dArr, "|", ""))
        [H3].Offset(k - 1, 0).Value = Cells(3, j)
        [I3].Offset(k - 1, 0).Value = ArrP1(i, j)
        [G3].Offset(k - 1, 0).Value = [A2].Value
    Next i
Next j
For j = 1 To 5
    For i = 1 To 4
        If ArrP2(i, j) = "" Then Exit For
        sArr = ArrP2(i, j) & "|"
        dArr = dArr & sArr
        k = Len(dArr) - Len(Replace(dArr, "|", ""))
        [H3].Offset(k - 1, 0).Value = Cells(10, j)
        [I3].Offset(k - 1, 0).Value = ArrP2(i, j)
        [G3].Offset(k - 1, 0).Value = [A9].Value
    Next i
Next j
End Sub

 

[giangleloi]

Buồn buồn viết thử, sao thấy củ chuối quá. Mọi người sửa giúp một số vấn đề:

Yêu cầu:

-Sắp xếp lại bảng nhiều cột thành 3 cột theo đề mục
-Bỏ qua các ô trống
Hiện code củ chuối của mình chưa xác định được vùng động cho Part 1 và Part 2

Bài gốc tại đây: http://www.excelforum.com/showthread.php?t=1150742&p=4451112#post4451112

Sub sd()
Dim ArrP1(), ArrP2(), List1(), List2(), a As Variant
Dim sArr, dArr As String
ReDim ArrP1(1 To 4, 1 To 5)
ReDim ArrP2(1 To 4, 1 To 5)
Dim i, j, k
[G3:I100].ClearContents
ArrP1 = Range("A4:E7")
ArrP2 = Range("A11:E14")
For j = 1 To 5
    For i = 1 To 4
        If ArrP1(i, j) = "" Then Exit For
        sArr = ArrP1(i, j) & "|"
        dArr = dArr & sArr
        k = Len(dArr) - Len(Replace(dArr, "|", ""))
        [H3].Offset(k - 1, 0).Value = Cells(3, j)
        [I3].Offset(k - 1, 0).Value = ArrP1(i, j)
        [G3].Offset(k - 1, 0).Value = [A2].Value
    Next i
Next j
For j = 1 To 5
    For i = 1 To 4
        If ArrP2(i, j) = "" Then Exit For
        sArr = ArrP2(i, j) & "|"
        dArr = dArr & sArr
        k = Len(dArr) - Len(Replace(dArr, "|", ""))
        [H3].Offset(k - 1, 0).Value = Cells(10, j)
        [I3].Offset(k - 1, 0).Value = ArrP2(i, j)
        [G3].Offset(k - 1, 0).Value = [A9].Value
    Next i
Next j
End Sub

Anh thử code này xem sao:

Sub Sap_Xep()
Dim Arr, vlArr, I, J, K
Arr = [A3:E14].Value
ReDim vlArr(1 To UBound(Arr, 1) * 5, 1 To 3)
 For J = 1 To 5
  For I = 2 To UBound(Arr, 1)
      If Arr(I, J) <> Empty And InStr(UCase(Arr(I, J)), "ITEM") Then
        K = K + 1
        If I < 5 Then
          vlArr(K, 1) = "Part 1"
          vlArr(K, 2) = Arr(1, J)
          vlArr(K, 3) = Arr(I, J)
         Else
          vlArr(K, 1) = "Part 2"
          vlArr(K, 2) = Arr(8, J)
          vlArr(K, 3) = Arr(I, J)
        End If
     End If
   Next I
 Next J
[A18].Resize(K, 3) = vlArr
[A18].Resize(K, 3).Sort [A18].Resize(K), xlAscending
End Sub

 

[concogia]

Buồn buồn viết thử, sao thấy củ chuối quá. Mọi người sửa giúp một số vấn đề:

Yêu cầu:

-Sắp xếp lại bảng nhiều cột thành 3 cột theo đề mục
-Bỏ qua các ô trống
Hiện code củ chuối của mình chưa xác định được vùng động cho Part 1 và Part 2

Bài gốc tại đây: http://www.excelforum.com/showthread.php?t=1150742&p=4451112#post4451112

Buồn buồn viết thử, sao thấy củ chuối quá

Vậy để lúc vui .....hãy viết nó sẽ thành củ......khác

Hiện code củ chuối của mình chưa xác định được vùng động cho Part 1 và Part 2

Dùng hộp thoại để khai báo vùng dữ liệu trong các trường hợp này sẽ chính xác hơn
*****Nên khai báo một biến mảng kết quả, chạy vòng lặp gán những dữ liệu thỏa vào, xong mới gán xuống Sheet
Híc, học viết code từ hồi nào mà.......
Híc

 

[bebo021999]

Cám ơn giangleloi và bác Cò

Mình vẫn đang phân vân chỗ này:

Anh thử code này xem sao:
Arr = [A3:E14].Value
[/Code]

Dùng hộp thoại để khai báo vùng dữ liệu trong các trường hợp này sẽ chính xác hơn

Vùng A3:E14 vẫn chưa phải là vùng "động", vì trên thực tế nó có thể có số dòng tuỳ ý.
Số dòng tối đa là từ PART1 đến dòng kế phía trên của PART2. Nếu dùng công thức có thể dùng OFFSET để chốt dòng cuối là dòng cuối cùng có dữ liệu trong các cột A tới E.

Bác Cò có gợi ý là dùng inputbox để khai báo vùng, nhưng như vậy nếu mỗi lần vùng thay đổi lại khai báo lại, mắc công quá

Xin hỏi: trong VBA, tại 1 vùng chứa dữ liệu, ví dụ, A3:C20, trong đó các ô có chứa dữ liệu cuối cùng trong tứng cột là A10, B15 và C12. Làm sao xác định ô có dữ liệu cuối cùng là B15? vùng A3:C20 sẽ resize thành A3:C15.

 

[huuthang_bd]

Xin hỏi: trong VBA, tại 1 vùng chứa dữ liệu, ví dụ, A3:C20, trong đó các ô có chứa dữ liệu cuối cùng trong tứng cột là A10, B15 và C12. Làm sao xác định ô có dữ liệu cuối cùng là B15? vùng A3:C20 sẽ resize thành A3:C15.

Bạn thử các cách này xem:
Cách 1

?Intersect(Selection, Selection.CurrentRegion).Address

Cách 2

?Range(Selection.Rows(1), Selection.Find(What:="*", After:=Selection.Cells(1), searchorder:=xlByRows, SearchDirection:=xlPrevious)).Address

 

[bebo021999]

Bạn thử các cách này xem:
Cách 1

?Intersect(Selection, Selection.CurrentRegion).Address

Cách 2

?Range(Selection.Rows(1), Selection.Find(What:="*", After:=Selection.Cells(1), searchorder:=xlByRows, SearchDirection:=xlPrevious)).Address

OK Thắng. Theo như VD trong hình, cách 2 làm được, với điều kiện là phải chọn tòan bộ vùng A3:E9 trước.

Nếu mình đứng tại ô đầu tiên A3, làm cách nào để biết trả về địa chỉ vùng A3:E9?

 

[huuthang_bd]

OK Thắng. Theo như VD trong hình, cách 2 làm được, với điều kiện là phải chọn tòan bộ vùng A3:E9 trước.

Nếu mình đứng tại ô đầu tiên A3, làm cách nào để biết trả về địa chỉ vùng A3:E9?

View attachment 163562

Selection chỉ là ví dụ thôi. Nó đại diện cho phạm vi tìm kiếm ban đầu. Code tại bài #5 là áp dụng cho trường hợp các cột của bảng dữ liệu đã được xác định, chỉ xác định dòng cuối cùng có dữ liệu.

Lấy hình ở bài 6 làm ví dụ. Giả sử muốn tìm vùng có dữ liệu trong phạm vi toàn bộ sheet thì ta có thể vận dụng code bài #5 như sau:

Sub ABC()
Dim xLeft As Long, xRight As Long, xTop As Long, xBottom As Long
With Cells
    xLeft = .Find(What:="*", After:=.Cells(.Cells.Rows.Count, .Cells.Columns.Count), SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column
    xRight = .Find(What:="*", After:=.Cells(1), SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    xTop = .Find(What:="*", After:=.Cells(.Cells.Rows.Count, .Cells.Columns.Count), SearchOrder:=xlByRows, SearchDirection:=xlNext).Row
    xBottom = .Find(What:="*", After:=.Cells(1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End With
MsgBox Range(Cells(xTop, xLeft), Cells(xBottom, xRight)).Address(0, 0)
End Sub