Chỉnh sửa Code xuất dữ liệu

[Bích Tỷ]

Mình có tham khảo đoạn code của anh @HieuCD (https://www.giaiphapexcel.com/diendan/threads/sửa-code-cho-hàm-vlookup.155774/#post-1029449) , mình muốn chỉnh sửa theo file của mình nhờ anh chị hỗ trợ.
Yêu cầu là: xuất cột % và cột bonus của các sheet W1->W5 theo điều kiện là LINE vào sheet Summary.
xin cảm ơn anh chị đã hỗ trợ hướng dẫn.

 

[Maika8008]

Bạn làm cho Đại lục hay Đài?

 

[Bích Tỷ]

Bạn làm cho Đại lục hay Đài?

Dạ, hiện mình làm cho công ty Đài bạn ơi.

 

[HieuCD]

Mình có tham khảo đoạn code của anh @HieuCD (https://www.giaiphapexcel.com/diendan/threads/sửa-code-cho-hàm-vlookup.155774/#post-1029449) , mình muốn chỉnh sửa theo file của mình nhờ anh chị hỗ trợ.
Yêu cầu là: xuất cột % và cột bonus của các sheet W1->W5 theo điều kiện là LINE vào sheet Summary.
xin cảm ơn anh chị đã hỗ trợ hướng dẫn.

Chạy code

Sub ABC()
  Dim Dic As Object, aLine(), sArr(), Res()
  Dim i&, sRow&, sR&, j&, jCol&
 
  Set Dic = CreateObject("scripting.dictionary")
  With Sheets("Summary")
    aLine = .Range("A8", .Range("A" & Rows.Count).End(xlUp)).Value
    sRow = UBound(aLine)
    For i = 1 To sRow
      If aLine(i, 1) <> Empty Then Dic.Item(aLine(i, 1)) = i
    Next
    ReDim Res(1 To sRow, 1 To 10)
    For j = 2 To 11 Step 2
      Dic.Add UCase(.Cells(2, j)), j - 1
    Next j
    For j = 1 To Sheets.Count
      jCol = Dic.Item(UCase(Sheets(j).Name))
      If jCol > 0 Then
        sArr = Sheets(j).Range("C4:S" & Sheets(j).Range("C" & Rows.Count).End(xlUp).Row).Value
        sR = UBound(sArr)
        For i = 1 To sR
          ir = Dic.Item(sArr(i, 1))
          If ir > 0 Then
            Res(ir, jCol) = sArr(i, 16)
            Res(ir, jCol + 1) = sArr(i, 17)
          End If
        Next i
      End If
    Next j
    .Range("B8").Resize(sRow, 10) = Res
  End With
End Sub

 

[Bích Tỷ]

Chạy code

Sub ABC()
  Dim Dic As Object, aLine(), sArr(), Res()
  Dim i&, sRow&, sR&, j&, jCol&
 
  Set Dic = CreateObject("scripting.dictionary")
  With Sheets("Summary")
    aLine = .Range("A8", .Range("A" & Rows.Count).End(xlUp)).Value
    sRow = UBound(aLine)
    For i = 1 To sRow
      If aLine(i, 1) <> Empty Then Dic.Item(aLine(i, 1)) = i
    Next
    ReDim Res(1 To sRow, 1 To 10)
    For j = 2 To 11 Step 2
      Dic.Add UCase(.Cells(2, j)), j - 1
    Next j
    For j = 1 To Sheets.Count
      jCol = Dic.Item(UCase(Sheets(j).Name))
      If jCol > 0 Then
        sArr = Sheets(j).Range("C4:S" & Sheets(j).Range("C" & Rows.Count).End(xlUp).Row).Value
        sR = UBound(sArr)
        For i = 1 To sR
          ir = Dic.Item(sArr(i, 1))
          If ir > 0 Then
            Res(ir, jCol) = sArr(i, 16)
            Res(ir, jCol + 1) = sArr(i, 17)
          End If
        Next i
      End If
    Next j
    .Range("B8").Resize(sRow, 10) = Res
  End With
End Sub

Dạ, cảm ơn anh. học hỏi được nhiều thứ quá, em mò mãi không biết chỉnh làm sao. e cứ coppy ra từng sub cho từng sheet.