Giúp sắp xếp dữ liệu các cột trong nhiều sheet.

[vncws99]

Chào các anh chị,
Em đang cập nhật dữ liệu và gặp vấn đề như sau :
HIện tại e có file excel gồm 2 bảng khá lớn như file (mỗi bảng ở 1 sheet).
Bây giờ e muốn cập nhật dữ liệu ở sheet "Giả thuyết 1" như sau:
Ở sheet " Giả thuyết 1" , các dữ liệu tại các cột số đầu năm được thay thế bằng dữ liệu số cuối năm ở sheet 2 tương ứng với từng công ty và từng tiêu chí. Các giữ liệu số cuối năm ở sheet "Giả thuyết 1" vẫn giữ nguyên.
Em tính copy mà nhiều quá (file gốc đến hơn 240 cột)

Nhờ anh/chị hỗ trợ, chỉ giáo giúp em với ạ.
Em cảm ơn anh/chị nhiều .

 

[HieuCD]

Chào các anh chị,
Em đang cập nhật dữ liệu và gặp vấn đề như sau :
HIện tại e có file excel gồm 2 bảng khá lớn như file (mỗi bảng ở 1 sheet).
Bây giờ e muốn cập nhật dữ liệu ở sheet "Giả thuyết 1" như sau:
Ở sheet " Giả thuyết 1" , các dữ liệu tại các cột số đầu năm được thay thế bằng dữ liệu số cuối năm ở sheet 2 tương ứng với từng công ty và từng tiêu chí. Các giữ liệu số cuối năm ở sheet "Giả thuyết 1" vẫn giữ nguyên.
Em tính copy mà nhiều quá (file gốc đến hơn 240 cột)

Nhờ anh/chị hỗ trợ, chỉ giáo giúp em với ạ.
Em cảm ơn anh/chị nhiều .

Chạy Code

Sub ABC()
  Dim sArr(), sArr2(), Res(), ikey$
  Dim eCol&, sCol&, eRow&, sRow&, i&, j&, iR&, jC&

  With Sheet1 'Gia thuyet 1
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    eCol = .Range("QQQ1").End(xlToLeft).Column
    sArr = .Range("A1").Resize(eRow, eCol).Value
  End With
  With Sheet2 'Gia thuyet 2
    eRow = .Range("A" & Rows.Count).End(xlUp).Row
    eCol = .Range("QQQ1").End(xlToLeft).Column
    sArr2 = .Range("A1").Resize(eRow, eCol).Value
  End With
  Application.ScreenUpdating = False
  With CreateObject("scripting.dictionary")
    sRow = UBound(sArr2)
    For i = 3 To sRow
      ikey = sArr(i, 1)
      If Len(ikey) Then .Item(ikey) = i
    Next i
    sCol = UBound(sArr2, 2)
    For j = 2 To sCol Step 2
      ikey = sArr2(1, j)
      If Len(ikey) Then .Item(ikey) = j
    Next j
    
    sRow = UBound(sArr)
    sCol = UBound(sArr, 2)
    For j = 3 To sCol Step 2
      jC = .Item(sArr(1, j))
      If jC > 0 Then
        ReDim Res(3 To sRow, 1 To 1)
        For i = 3 To sRow
          iR = .Item(sArr(i, 1))
          If iR > 0 Then Res(i, 1) = sArr2(iR, jC)
        Next i
      End If
      Sheet1.Cells(3, j).Resize(sRow - 2) = Res
    Next j
  End With
  Application.ScreenUpdating = True
End Sub

 

[vncws99]

E chạy được rồi , cảm ơn anh nhé.