Hướng dẫn lấy dữ liệu từ sheet1 sang sheet2 bằng VBA

Liên hệ QC

thanhduytlv

Thành viên mới
Tham gia
4/7/10
Bài viết
35
Được thích
4
Chào các anh/chị diễn đàn GPE!
Mình có file dữ liệu ở Sheet1 và muốn lấy dữ liệu sang sheet2 theo các SKU tương ứng.
Nhờ các anh chị hướng dẫn dùm cách lấy dữ liệu bằng VBA ( hàm Vlookup thì file dữ liệu lớn >92k dòng và truy xuất từ nhiều sheet khác nhau trong file) để mình có thể áp dụng thêm ơ nhiều sheet khác trong dữ liệu.
File đính kèm
Rất cám ơn anh/chị diễn đàn.
 

File đính kèm

  • DMHH_GOC.xlsx
    726.6 KB · Đọc: 40
Chào các anh/chị diễn đàn GPE!
Mình có file dữ liệu ở Sheet1 và muốn lấy dữ liệu sang sheet2 theo các SKU tương ứng.
Nhờ các anh chị hướng dẫn dùm cách lấy dữ liệu bằng VBA ( hàm Vlookup thì file dữ liệu lớn >92k dòng và truy xuất từ nhiều sheet khác nhau trong file) để mình có thể áp dụng thêm ơ nhiều sheet khác trong dữ liệu.
File đính kèm
Rất cám ơn anh/chị diễn đàn.
Bạn chạy thử code này xem sao
Mã:
Option Explicit

Sub Loc()
Dim Nguon
Dim BangTra
Dim DL
Dim Kq
Dim i, j, k
Nguon = Sheet1.Range("a4", Sheet1.Range("p4").End(xlDown))
ReDim BangTra(1 To 4000000)
For i = 2 To UBound(Nguon)
    j = Nguon(i, 1)
    BangTra(j) = i
Next i
DL = Sheet2.Range("a4", Sheet2.Range("a4").End(xlDown))
ReDim Kq(1 To UBound(DL), 1 To UBound(Nguon, 2) - 1)
For i = 1 To UBound(DL)
    k = BangTra(DL(i, 1))
    If k <> "" Then
        For j = 2 To UBound(Nguon, 2)
            Kq(i, j - 1) = Nguon(k, j)
        Next j
    End If
Next i
With Sheet2
.Range("b4").Resize(UBound(Kq), UBound(Kq, 2)).Clear
.Range("b4").Resize(UBound(Kq), UBound(Kq, 2)) = Kq
.Range("a3").CurrentRegion.Borders.LineStyle = 1
.Range("a3").CurrentRegion.Columns.AutoFit
End With
End Sub
 
Chào các anh/chị diễn đàn GPE!
Mình có file dữ liệu ở Sheet1 và muốn lấy dữ liệu sang sheet2 theo các SKU tương ứng.
Nhờ các anh chị hướng dẫn dùm cách lấy dữ liệu bằng VBA ( hàm Vlookup thì file dữ liệu lớn >92k dòng và truy xuất từ nhiều sheet khác nhau trong file) để mình có thể áp dụng thêm ơ nhiều sheet khác trong dữ liệu.
File đính kèm
Rất cám ơn anh/chị diễn đàn.
Bạn thử
Code trong sheet2
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long, result()

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Set change = Intersect(Range("A4:A600000"), Target)
    If Not change Is Nothing Then
        If Dic Is Nothing Then Vlookup
        result = change.Resize(change.Rows.Count + 1).Value
        ReDim Preserve result(1 To UBound(result), 1 To 15)
 
        For i = 1 To UBound(result) - 1
            If Len(result(i, 1)) Then
                tmp = result(i, 1)
                If Dic.exists(tmp) Then
                    result(i, 1) = aResult(Dic.Item(tmp), 2) 'VENDOR
                    result(i, 2) = aResult(Dic.Item(tmp), 3) 'Supplier Name
                    result(i, 3) = aResult(Dic.Item(tmp), 4) 'UPC
                    result(i, 4) = aResult(Dic.Item(tmp), 5) 'SKU PHU
                    result(i, 5) = aResult(Dic.Item(tmp), 6) 'DESCRIPTION
                    result(i, 6) = aResult(Dic.Item(tmp), 7) 'PRICE
                    result(i, 7) = aResult(Dic.Item(tmp), 8) 'DEPT
                    result(i, 8) = aResult(Dic.Item(tmp), 9) 'SUB_DEPT
                    result(i, 9) = aResult(Dic.Item(tmp), 10) 'CLASSNUM
                    result(i, 10) = aResult(Dic.Item(tmp), 11) 'SUB_CLASS
                    result(i, 11) = aResult(Dic.Item(tmp), 12) 'TAX1
                    result(i, 12) = aResult(Dic.Item(tmp), 13) 'STATUS
                    result(i, 13) = aResult(Dic.Item(tmp), 14) 'BUY_UNIT
                    result(i, 14) = aResult(Dic.Item(tmp), 15) 'SELL_UNIT
                    result(i, 15) = aResult(Dic.Item(tmp), 16) 'Nhóm
                Else
                    result(i, 1) = ""
                End If
            End If
        Next i
        change.Offset(0, 1).Resize(, 15).Value = result
    End If
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
'-------------'
Code bỏ trong module1
Mã:
Option Explicit
Public Chk As Boolean, Dic As Object, aResult()
Sub Vlookup()
Dim wks As Worksheet, SrcRng As Range, sArray
  Dim LR As Long, i As Long, n As Long, tmp
  On Error Resume Next
  Set wks = Sheets("Sheet1")
  Set SrcRng = wks.Range("A4:P60000")
  sArray = SrcRng.Value
  ReDim aResult(1 To UBound(sArray, 1), 1 To UBound(sArray, 2))
  Set Dic = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(sArray, 1)
    If CStr(sArray(i, 1)) <> "" Then
      tmp = sArray(i, 1)
      If Not Dic.exists(tmp) Then
        LR = LR + 1
        Dic.Add tmp, LR
        aResult(LR, 1) = tmp
        aResult(LR, 2) = sArray(i, 2) 'VENDOR
        aResult(LR, 3) = sArray(i, 3) 'Supplier Name
        aResult(LR, 4) = sArray(i, 4) 'UPC
        aResult(LR, 5) = sArray(i, 5) 'SKU PHU
        aResult(LR, 6) = sArray(i, 6) 'Ma Dan Nong
        aResult(LR, 7) = sArray(i, 7) 'DESCRIPTION
        aResult(LR, 8) = sArray(i, 8) 'PRICE
        aResult(LR, 9) = sArray(i, 9) 'DEPT
        aResult(LR, 10) = sArray(i, 10) 'SUB_DEPT
        aResult(LR, 11) = sArray(i, 11) 'CLASSNUM
        aResult(LR, 12) = sArray(i, 12) 'SUB_CLASS
        aResult(LR, 13) = sArray(i, 13) 'AX1
        aResult(LR, 14) = sArray(i, 14) 'STATUS
        aResult(LR, 15) = sArray(i, 15) 'BUY_UNIT
        aResult(LR, 16) = sArray(i, 16) 'SELL_UNIT
        aResult(LR, 17) = sArray(i, 17) 'NHOM
    
      End If
    End If
  Next
End Sub
 

File đính kèm

  • DMHH_GOC.xlsb
    292.5 KB · Đọc: 30
Chào các anh/chị diễn đàn GPE!
Mình có file dữ liệu ở Sheet1 và muốn lấy dữ liệu sang sheet2 theo các SKU tương ứng.
Nhờ các anh chị hướng dẫn dùm cách lấy dữ liệu bằng VBA ( hàm Vlookup thì file dữ liệu lớn >92k dòng và truy xuất từ nhiều sheet khác nhau trong file) để mình có thể áp dụng thêm ơ nhiều sheet khác trong dữ liệu.
File đính kèm
Rất cám ơn anh/chị diễn đàn.

Rất cám ơn 2 anh CHAOQUAY, LamNA.
Code của 2 anh viết đều ra cùng 1 kết quả theo yêu cầu.
Và theo cá nhân thì rất cao siêu nên mình chưa hiểu được.
Rất mong hai anh có thể hướng dẫn chi tiết để em có thể dùng VBA lấy dữ liệu cột từ các sheet khác vì file gốc phải lấy dữ liệu từ 2-3 cột trong các sheet khác nhau ( mỗi sheet có dữ liệu từ vài trăm đến vài ngàn dòng ).
File data gốc có dung lượng trên 9M ( chưa có công thức vlookup ) nên không thể gửi lên được.
Rất mong 2 anh giúp dùm.
Chân thành cám ơn 2 anh rất nhiều.
 
Lần chỉnh sửa cuối:
Code này dễ hiểu hơn nè, vì nó chạy như rùa í:
PHP:
Sub ChuyenDuLieu()
 Dim Cls As Range, Rng As Range, sRng As Range
 Dim Col As Integer
 
 With Sheet1
    Set Rng = .Range(.[a3], .[A65500].End(xlUp))
 End With
 Application.ScreenUpdating = False
 With Sheet2
    Col = .[B3].CurrentRegion.Columns.Count
    For Each Cls In .Range(.[A4], .[A4].End(xlDown))
        Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
        If Not sRng Is Nothing Then
            Cls.Offset(, 1).Resize(, Col).Value = sRng.Offset(, 1).Resize(, Col).Value
        End If
    Next Cls
 End With
 Application.ScreenUpdating = True
End Sub
 
Rất cám ơn 2 anh CHAOQUAY, LamNA.
Code của 2 anh viết đều ra cùng 1 kết quả theo yêu cầu.
Và theo cá nhân thì rất cao siêu nên mình chưa hiểu được.
Rất mong hai anh có thể hướng dẫn chi tiết để em có thể dùng VBA lấy dữ liệu cột từ các sheet khác vì file gốc phải lấy dữ liệu từ 2-3 cột trong các sheet khác nhau ( mỗi sheet có dữ liệu từ vài trăm đến vài ngàn dòng ).
File data gốc có dung lượng trên 9M ( chưa có công thức vlookup ) nên không thể gửi lên được.
Rất mong 2 anh giúp dùm.
Chân thành cám ơn 2 anh rất nhiều.
Bạn xem thử
Mã:
Option Explicit

Sub Loc()
'3 Buoc:
'Tao bangtra ghi lai chi so dong cua cac SKU trong sheet1
'Lap mang DL chua cac SKU cua sheet2, lap mang chua cac so lieu ket qua
'Lay cac SKU trong DL so voi bang tra, lay ra chi so dong, nap so lieu cua dong do vao mang Kq
Dim Nguon
Dim BangTra
Dim DL
Dim Kq
Dim i, j, k
Nguon = Sheet1.Range("a4", Sheet1.Range("p4").End(xlDown))
'Tao bang tra
ReDim BangTra(1 To 4000000)
For i = 2 To UBound(Nguon)
    j = Nguon(i, 1) 'Vi tri cua phan tu trong BangTra lay = chi so SKU tai sheet1
    BangTra(j) = i 'Gia tri dien tai vi tri do la chi so dong cua SKU trong mang Nguon
Next i
'Xong Tao bang tra

'Nap mang DL: Chua SKU cua sheet2; Tao mang Kq: So dong = so dong cua DL, so cot = so cot cua Nguon - 1 ( Bo cot SKU )
DL = Sheet2.Range("a4", Sheet2.Range("a4").End(xlDown))
ReDim Kq(1 To UBound(DL), 1 To UBound(Nguon, 2) - 1)
'Xong Nap mang DL: Chua SKU cua sheet2; Tao mang Kq: So dong = so dong cua DL, so cot = so cot cua Nguon - 1 ( Bo cot SKU )

'Nap so lieu tra cuu vao mang ket qua Kq
For i = 1 To UBound(DL)
    k = BangTra(DL(i, 1)) ' k = gia tri cua BangTra tai vi tri = SKU cua DL(i, 1),  ( k = chi so dong trong mang Nguon )
    If k <> "" Then
        For j = 2 To UBound(Nguon, 2)
            Kq(i, j - 1) = Nguon(k, j)
        Next j
    End If
Next i
'Xong Nap so lieu tra cuu vao mang ket qua Kq
With Sheet2
.Range("b4").Resize(UBound(Kq), UBound(Kq, 2)).Clear
.Range("b4").Resize(UBound(Kq), UBound(Kq, 2)) = Kq
.Range("a3").CurrentRegion.Borders.LineStyle = 1
.Range("a3").CurrentRegion.Columns.AutoFit
End With
End Sub
 
Bạn xem thử
Mã:
Option Explicit

Sub Loc()
'3 Buoc:
'Tao bangtra ghi lai chi so dong cua cac SKU trong sheet1
'Lap mang DL chua cac SKU cua sheet2, lap mang chua cac so lieu ket qua
'Lay cac SKU trong DL so voi bang tra, lay ra chi so dong, nap so lieu cua dong do vao mang Kq
Dim Nguon
Dim BangTra
Dim DL
Dim Kq
Dim i, j, k
Nguon = Sheet1.Range("a4", Sheet1.Range("p4").End(xlDown))
'Tao bang tra
ReDim BangTra(1 To 4000000)
For i = 2 To UBound(Nguon)
    j = Nguon(i, 1) 'Vi tri cua phan tu trong BangTra lay = chi so SKU tai sheet1
    BangTra(j) = i 'Gia tri dien tai vi tri do la chi so dong cua SKU trong mang Nguon
Next i
'Xong Tao bang tra

'Nap mang DL: Chua SKU cua sheet2; Tao mang Kq: So dong = so dong cua DL, so cot = so cot cua Nguon - 1 ( Bo cot SKU )
DL = Sheet2.Range("a4", Sheet2.Range("a4").End(xlDown))
ReDim Kq(1 To UBound(DL), 1 To UBound(Nguon, 2) - 1)
'Xong Nap mang DL: Chua SKU cua sheet2; Tao mang Kq: So dong = so dong cua DL, so cot = so cot cua Nguon - 1 ( Bo cot SKU )

'Nap so lieu tra cuu vao mang ket qua Kq
For i = 1 To UBound(DL)
    k = BangTra(DL(i, 1)) ' k = gia tri cua BangTra tai vi tri = SKU cua DL(i, 1),  ( k = chi so dong trong mang Nguon )
    If k <> "" Then
        For j = 2 To UBound(Nguon, 2)
            Kq(i, j - 1) = Nguon(k, j)
        Next j
    End If
Next i
'Xong Nap so lieu tra cuu vao mang ket qua Kq
With Sheet2
.Range("b4").Resize(UBound(Kq), UBound(Kq, 2)).Clear
.Range("b4").Resize(UBound(Kq), UBound(Kq, 2)) = Kq
.Range("a3").CurrentRegion.Borders.LineStyle = 1
.Range("a3").CurrentRegion.Columns.AutoFit
End With
End Sub
Rất cám ơn anh CHAOQUAY đã giúp.
Để chiều về mình xem và có gì chưa hiểu rất mong anh giúp đỡ dùm.
Cám ơn anh rất nhiều.
 
Rất cám ơn 2 anh CHAOQUAY, LamNA.
Code của 2 anh viết đều ra cùng 1 kết quả theo yêu cầu.
Và theo cá nhân thì rất cao siêu nên mình chưa hiểu được.
Rất mong hai anh có thể hướng dẫn chi tiết để em có thể dùng VBA lấy dữ liệu cột từ các sheet khác vì file gốc phải lấy dữ liệu từ 2-3 cột trong các sheet khác nhau ( mỗi sheet có dữ liệu từ vài trăm đến vài ngàn dòng ).
File data gốc có dung lượng trên 9M ( chưa có công thức vlookup ) nên không thể gửi lên được.
Rất mong 2 anh giúp dùm.
Chân thành cám ơn 2 anh rất nhiều.
Nếu lấy từ nhiều sheet nên dùng Dic gán Mã sheet kết quả, do cột lấy dữ liệu không cụ thể nên xét từng cột một cho bạn dể tùy biến
Mã:
Sub Vlookup_VBA()
  Dim sArr(), Res(), Dic As Object, iKey
  Dim eRow As Long, sRow As Long, sCol As Long, i As Long, ik As Long, j As Long
  Set Dic = CreateObject("Scripting.Dictionary")
  With Sheets("Sheet2") 'Sheet Ket qua
    eRow = .Range("A1048576").End(xlUp).Row
    If eRow < 4 Then MsgBox ("Khong có du lieu tim kiem"): Exit Sub
    Application.ScreenUpdating = False
    Range("B4:P" & eRow).ClearContents
    Res = .Range("A4:P" & eRow).Value
    sRow = UBound(Res)
  End With
  For i = 1 To sRow 'Add ma tim kiem
    iKey = Res(i, 1) 'Ma SKU
    If Len(iKey) > 0 Then
      If Dic.exists(iKey) = False Then Dic.Add iKey, i
    End If
  Next i

  With Sheets("Sheet1") 'Lay ket qua tu sheet1
    eRow = .Range("A1048576").End(xlUp).Row
    If eRow > 3 Then
      sArr = .Range("A4:P" & eRow).Value
      For i = 1 To UBound(sArr)
        iKey = sArr(i, 1) 'Ma SKU
        If Dic.exists(iKey) Then
          ik = Dic.Item(iKey)
          Res(ik, 2) = sArr(i, 2) 'Lay du lieu tu cot 2
          Res(ik, 3) = sArr(i, 3) 'Lay du lieu tu cot 3
          Res(ik, 4) = sArr(i, 4) 'Lay du lieu tu cot 4
          '...
        End If
      Next i
    End If
  End With

  'With Sheets("Sheet3") 'Lay ket qua tu sheet3
    '....
    '....
  'End With
 
  With Sheet2
    .Range("A4:P4").Resize(sRow) = Res 'Gan ket qua
  End With
  Application.ScreenUpdating = True
End Sub
 

File đính kèm

  • DMHH_GOC.xlsm
    839.5 KB · Đọc: 30
Nếu lấy từ nhiều sheet nên dùng Dic gán Mã sheet kết quả, do cột lấy dữ liệu không cụ thể nên xét từng cột một cho bạn dể tùy biến
Mã:
Sub Vlookup_VBA()
  Dim sArr(), Res(), Dic As Object, iKey
  Dim eRow As Long, sRow As Long, sCol As Long, i As Long, ik As Long, j As Long
  Set Dic = CreateObject("Scripting.Dictionary")
  With Sheets("Sheet2") 'Sheet Ket qua
    eRow = .Range("A1048576").End(xlUp).Row
    If eRow < 4 Then MsgBox ("Khong có du lieu tim kiem"): Exit Sub
    Application.ScreenUpdating = False
    Range("B4:P" & eRow).ClearContents
    Res = .Range("A4:P" & eRow).Value
    sRow = UBound(Res)
  End With
  For i = 1 To sRow 'Add ma tim kiem
    iKey = Res(i, 1) 'Ma SKU
    If Len(iKey) > 0 Then
      If Dic.exists(iKey) = False Then Dic.Add iKey, i
    End If
  Next i

  With Sheets("Sheet1") 'Lay ket qua tu sheet1
    eRow = .Range("A1048576").End(xlUp).Row
    If eRow > 3 Then
      sArr = .Range("A4:P" & eRow).Value
      For i = 1 To UBound(sArr)
        iKey = sArr(i, 1) 'Ma SKU
        If Dic.exists(iKey) Then
          ik = Dic.Item(iKey)
          Res(ik, 2) = sArr(i, 2) 'Lay du lieu tu cot 2
          Res(ik, 3) = sArr(i, 3) 'Lay du lieu tu cot 3
          Res(ik, 4) = sArr(i, 4) 'Lay du lieu tu cot 4
          '...
        End If
      Next i
    End If
  End With

  'With Sheets("Sheet3") 'Lay ket qua tu sheet3
    '....
    '....
  'End With

  With Sheet2
    .Range("A4:P4").Resize(sRow) = Res 'Gan ket qua
  End With
  Application.ScreenUpdating = True
End Sub
Thân chào anh HieuCD
Code anh viết rất nhanh và chuẩn. Đối với người đang tìm hiểu VBA rất dễ chỉnh theo ý muốn.
Rất mong được anh hướng dẫn để mình có thể hoàn thành file quản lý hàng hóa này.
Tối mai mình sẽ cố gắng gửi file chuẩn( đủ các sheet với dữ liệu khoảng 30 dòng mỗi sheet )
Rất mong anh giúp dùm.
Cám ơn anh nhiều.
Note: Diễn đàn cho up file được bao nhiêu Mb để minh điều chỉnh dung lượng file.
 
Thân chào anh HieuCD
Code anh viết rất nhanh và chuẩn. Đối với người đang tìm hiểu VBA rất dễ chỉnh theo ý muốn.
Rất mong được anh hướng dẫn để mình có thể hoàn thành file quản lý hàng hóa này.
Tối mai mình sẽ cố gắng gửi file chuẩn( đủ các sheet với dữ liệu khoảng 30 dòng mỗi sheet )
Rất mong anh giúp dùm.
Cám ơn anh nhiều.
Note: Diễn đàn cho up file được bao nhiêu Mb để minh điều chỉnh dung lượng file.
Gửi anh HieuCD
File trên 7Mb nên diễn đàn ko úp file được.
Anh cho mình xin địa chỉ mail để gửi file mẫu.
Cám ơn.
 
Thân chào anh HieuCD
Code anh viết rất nhanh và chuẩn. Đối với người đang tìm hiểu VBA rất dễ chỉnh theo ý muốn.
Rất mong được anh hướng dẫn để mình có thể hoàn thành file quản lý hàng hóa này.
Tối mai mình sẽ cố gắng gửi file chuẩn( đủ các sheet với dữ liệu khoảng 30 dòng mỗi sheet )
Rất mong anh giúp dùm.
Cám ơn anh nhiều.
Note: Diễn đàn cho up file được bao nhiêu Mb để minh điều chỉnh dung lượng file.
Nếu bạn hiểu được cách lấy dữ liệu sheet A vào sheet B, thì việc lấy được tất cả các sheet vào 1 sheet là chuyện rất nhỏ, ở trên diễn đàn cũng có nhiều dạng về bài này rồi, bạn thử tìm kiếm xem sao
 
Gửi anh HieuCD
File trên 7Mb nên diễn đàn ko úp file được.
Anh cho mình xin địa chỉ mail để gửi file mẫu.
Cám ơn.
Sao bạn không xóa bớt dữ liệu cho giảm dung lượng rồi tải File lên (sẽ được nhiều thành viên giúp hơn).
 
Mình đã xóa chừa mỗi sheet hơn 10 dòng mà file không giảm hơn được. Bó tay.
Có thể do bạn Format cả cột hoặc cả dòng nên Excel nó hiểu rằng bạn đã sử dụng hết số dòng hoặc số cột ở bảng tính. Bằng cách bạn nhìn thanh kéo trái phải hoặc lên xuống nếu thấy nó nhỏ tihi kéo mãi xuống tít dưới mà dữ liệu chẳng thấy đâu thì đó là dấu hiệu.
Bạn nên xóa những dòng thừa này.
 
Web KT
Back
Top Bottom