Xin giúp code VBA copy (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

hoang0569

Thành viên thường trực
Tham gia
21/7/09
Bài viết
316
Được thích
8
Mình gửi File kèm mong các bạn giúp, xin cảm ơn nhiều
 

File đính kèm

Mình gửi File kèm mong các bạn giúp, xin cảm ơn nhiều
Chay code
Mã:
Sub ABC()
  Dim sArr(), Arr() As Long, Res()
  Dim i&, iR&, n&, j&, jC&, sCol&, sRow&, tmp
 
  On Error Resume Next
  sArr = Range("G2:M9").Value
  sRow = UBound(sArr, 1): sCol = UBound(sArr, 2)
  ReDim Arr(0 To 9, 0 To 9)
  For i = 1 To sRow
    For j = 1 To sCol
      tmp = sArr(i, j)
      If tmp <> Empty Then
        iR = tmp Mod 10:     jC = tmp \ 10
        Arr(iR, jC) = Arr(iR, jC) + 1
      End If
    Next j
  Next i
  ReDim Res(1 To 200, 0 To 9) 'Max 200 dong ket qua
  sRow = 0
  For j = 0 To 9
    k = 0
    For i = 0 To 9
      For n = 1 To Arr(i, j)
        k = k + 1
        Res(k, j) = i + j * 10
      Next n
    Next i
    If k > sRow Then sRow = k
  Next j
  Range("B13:K212").ClearContents
  Range("B13").Resize(sRow, 10) = Res
End Sub
 
Upvote 0
Cảm ơn bạn nhiều, chúc bạn vui nhiều
 
Upvote 0
Xin hỏi thêm anh HieuCD và các anh em, code VBA trên của anh HieuCD chạy đã ổn nhưng giờ có xuất hiện số 00 thì code bỏ xót, nhờ anh HieuCD và anh em giúp hòan thiện nốt nhé. xin cảm ơn.
 

File đính kèm

Upvote 0
Xin hỏi thêm anh HieuCD và các anh em, code VBA trên của anh HieuCD chạy đã ổn nhưng giờ có xuất hiện số 00 thì code bỏ xót, nhờ anh HieuCD và anh em giúp hòan thiện nốt nhé. xin cảm ơn.
Vì giá trị là 0 thì code hiểu là giá trị rỗng nên không liệt kê,Bạn thử khai báo "tmp As String" xem
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom