Hỗ trợ xử lý bài toán

Chia sẻ bởi:hands

★★★★★

‹ Hỗ trợ tìm vị trí, gộp vị... Nhờ viết dùm code vòng lập lấy... ›

Quảng cáo

Như tiêu đề, hiện em đang có bài tập cần sắp xếp lại bảng excel với dữ liệu có sẵn thành 1 bảng excel mới.
Anh Chị có cao kiến giúp em với.

Lần sau nên gởi file

Sub ABC()
  Dim arr(), c(), res(), sRow&, sCol&, i&, j&, pha&, k&

arr = Range("B2:F" & Range("B1000000").End(xlUp).Row).Value
  sRow = UBound(arr): sCol = UBound(arr, 2)
  ReDim res(1 To sRow * sCol, 1 To 4)
  For j = 2 To sCol
    ReDim c(1 To 2)
    For i = 2 To sRow
      pha = Right(arr(i, j), 1)
      c(pha) = c(pha) + 1
      res(k + c(pha), 1) = k + c(pha)
      res(k + c(pha), 2) = arr(1, j)
      res(k + c(pha), pha + 2) = arr(i, 1)
    Next i
    If c(1) > c(2) Then k = k + c(1) Else k = k + c(2)
  Next j
  Range("H3").Resize(UBound(res), 4) = res
End Sub

Anh ơi, Anh có thể giúp em nếu cho thêm phase 3 và phase 4 hoặc giá trị rỗng bên trong bảng 1 thì đoạn code sẽ ntn dc k ạ?
Em xin đợi anh cho thêm hướng dẫn ạ.
Em k up đc file vì laptop chặn upload file ra ngoài :(.
Em cảm ơn a nhiều.

Tối đa 9 Phase

Sub ABC()
  Dim arr(), c(), res(), sRow&, sCol&, i&, j&, pha&, k&
  Const cp As Long = 9 'Toi da 9 Phase

arr = Range("B2:F" & Range("B1000000").End(xlUp).Row).Value
  sRow = UBound(arr): sCol = UBound(arr, 2)
  ReDim res(1 To sRow * sCol, 1 To cp + 2)
  For j = 2 To sCol
    ReDim c(0 To cp)
    For i = 2 To sRow
      If arr(i, j) <> Empty Then
        pha = Right(arr(i, j), 1)
        c(pha) = c(pha) + 1
        res(k + c(pha), 1) = k + c(pha)
        res(k + c(pha), 2) = arr(1, j)
        res(k + c(pha), pha + 2) = arr(i, 1)
        If c(0) < c(pha) Then c(0) = c(pha)
      End If
    Next i
    k = k + c(0)
  Next j
  Range("H3").Resize(UBound(res), cp + 2) = res
End Sub

Lưu ý, theo nội quy của diễn đàn bạn không nên dùng từ viết tắt