Giúp mình truy xuất dữ liệu từ một Data tổng hợp (1 người xem)

Liên hệ QC

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

reddolphin

Thành viên mới
Tham gia
5/11/09
Bài viết
11
Được thích
0
Mình có một vài điều cần các bạn giúp đỡ.
Mình có 1 Sh Tonghop các thông tin, mình muốn truy xuất dữ liệu từ Sheet này sang sheet khác làm báo cáo. Trong file đính kèm mình có nói chi tiết hơn, các bạn giúp mình với. -\\/.
 

File đính kèm

Mình có một vài điều cần các bạn giúp đỡ.
Mình có 1 Sh Tonghop các thông tin, mình muốn truy xuất dữ liệu từ Sheet này sang sheet khác làm báo cáo. Trong file đính kèm mình có nói chi tiết hơn, các bạn giúp mình với. -\\/.

Bạn xem file đính kèm nhé.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Bạn xem file đính kèm nhé.
Xin cảm ơn bạn...!
Đúng như mình cần rồi đấy. Nhưng bạn có thể cho mình hỏi thêm, nếu mình muốn thay đổi (thêm/bớt) cột dữ liệu truy xuất trong sheet xuatDL thì ở code mình thay đổi như thế nào. Mình cũng muốn bạn diễn giả thêm đoạn code bạn viết là sao.
Học hỏi ở bạn chút..
 
Upvote 0
Xin cảm ơn bạn...!
Đúng như mình cần rồi đấy. Nhưng bạn có thể cho mình hỏi thêm, nếu mình muốn thay đổi (thêm/bớt) cột dữ liệu truy xuất trong sheet xuatDL thì ở code mình thay đổi như thế nào. Mình cũng muốn bạn diễn giả thêm đoạn code bạn viết là sao.
Học hỏi ở bạn chút..

Mình chẳng biết diễn giải sao cho bạn hiểu, thôi thì bạn đọc các chú thích này và ngâm cứu thêm vậy:

Mã:
Public Sub Loc()
[COLOR=#0000cd]'Khai bao cac bien[/COLOR]
Dim SrcArr, ResArr()
Dim lR As Long, lC As Long, k As Long
Dim sTag As String
[COLOR=#0000cd]'Tat che do cap nhat man hinh[/COLOR]
Application.ScreenUpdating = False
[COLOR=#0000cd]'Lay du lieu sheet "tong hop" vao mang SrcArr[/COLOR]
SrcArr = Sheet12.Range(Sheet12.[A15], Sheet12.[A65000].End(xlUp)).Resize(, 10).Value
With Sheet1
  [COLOR=#0000cd]'Dat sTag = du lieu o sheet1 o J3[/COLOR]
  sTag = UCase(.[J3].Value)
  [COLOR=#0000cd]'Khai bao lai mang ResArr[/COLOR]
  ReDim ResArr(1 To UBound(SrcArr, 1), 1 To 9)
   [COLOR=#0000cd] 'dung vong lap duyet qua tung dong cua mang[/COLOR]
    For lR = 1 To UBound(SrcArr, 1)
     [COLOR=#0000cd] ' Neu dong nao trong cot 9 thoa dieu kien thi...[/COLOR]
      If UCase(SrcArr(lR, 9)) = sTag Then
       [COLOR=#0000cd] 'Danh dau dong do va dong thoi tao dong trong mang ResArr[/COLOR]
        k = k + 1
      [COLOR=#0000cd]  'Dung vong lap duyet qua 8 cot lien ke cua mang SrcArr[/COLOR]
        For lC = 1 To 8
        [COLOR=#0000cd]  'Lay du lieu tung cot trong mang SrcArr khi thoa DK cho vao mang ResArr[/COLOR]
          ResArr(k, lC) = SrcArr(lR, lC)
          [COLOR=#0000cd]' Lay du lieu o cot 10 mang SrcArr cho vao cot 9 mang ResArr[/COLOR]
          ResArr(k, 9) = SrcArr(lR, 10)
       [COLOR=#0000cd] 'Duyet tiep den het 8 cot trong mang SrcArr[/COLOR]
        Next lC
     [COLOR=#0000cd] 'ket thuc dk[/COLOR]
      End If
    [COLOR=#0000cd]'Duyet tiep den het dong trong mang SrcArr[/COLOR]
    Next lR
  [COLOR=#0000cd]'Neu co du lieu thoa dk thi[/COLOR]
  If k Then
    With .[A7]
     [COLOR=#0000cd] 'Xoa vung co du lieu cu[/COLOR]
      .Resize(lR, 9).Clear
     [COLOR=#0000cd] ' Gan du lieu tu mang ResArr xuong sheet[/COLOR]
      .Resize(k, 9).Value = ResArr
      'Ke o vung du lieu
      .Resize(k + 1, 9).Borders.LineStyle = xlContinuous
     [COLOR=#0000cd] 'Nhap "Total" vao cot A dong cuoi cung du lieu[/COLOR]
      .Offset(k) = "Total:"
     [COLOR=#0000cd] 'Format dam dong cuoi cung[/COLOR]
      .Offset(k).Resize(, 9).Font.Bold = True
      [COLOR=#0000cd]'Tinh tong "Thu, Chi Ton" (dong cuoi)[/COLOR]
      .Offset(k, 5).Resize(, 3).FormulaR1C1 = "=SUM(R7C:R[-1]C)"
      [COLOR=#0000cd]'Format So tien dang "#,##0"[/COLOR]
      .Offset(, 5).Resize(k + 1, 3).NumberFormat = "#,##0"
     [COLOR=#0000cd] 'Format 2 cot ngay dang "dd/mm/yyyy"[/COLOR]
      .Offset(, 8).Resize(k).NumberFormat = "dd/mm/yyyy"
      .Resize(k).NumberFormat = "dd/mm/yyyy"
    End With
  Else
    [COLOR=#0000cd]'Khong thi thong bao khong co du lieu[/COLOR]
    MsgBox "No record found"
 [COLOR=#0000cd] 'Ket thuc dk[/COLOR]
  End If
End With
[COLOR=#0000cd]'Bat che do nhat man hinh[/COLOR]
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Mình chẳng biết diễn giải sao cho bạn hiểu, thôi thì bạn đọc các chú thích này và ngâm cứu thêm vậy:

Mã:
Public Sub Loc()
[COLOR=#0000cd]'Khai bao cac bien[/COLOR]
Dim SrcArr, ResArr()
Dim lR As Long, lC As Long, k As Long
Dim sTag As String
[COLOR=#0000cd]'Tat che do cap nhat man hinh[/COLOR]
Application.ScreenUpdating = False
[COLOR=#0000cd]'Lay du lieu sheet "tong hop" vao mang SrcArr[/COLOR]
SrcArr = Sheet12.Range(Sheet12.[A15], Sheet12.[A65000].End(xlUp)).Resize(, 10).Value
With Sheet1
  [COLOR=#0000cd]'Dat sTag = du lieu o sheet1 o J3[/COLOR]
  sTag = UCase(.[J3].Value)
  [COLOR=#0000cd]'Khai bao lai mang ResArr[/COLOR]
  ReDim ResArr(1 To UBound(SrcArr, 1), 1 To 9)
   [COLOR=#0000cd] 'dung vong lap duyet qua tung dong cua mang[/COLOR]
    For lR = 1 To UBound(SrcArr, 1)
     [COLOR=#0000cd] ' Neu dong nao trong cot 9 thoa dieu kien thi...[/COLOR]
      If UCase(SrcArr(lR, 9)) = sTag Then
       [COLOR=#0000cd] 'Danh dau dong do va dong thoi tao dong trong mang ResArr[/COLOR]
        k = k + 1
      [COLOR=#0000cd]  'Dung vong lap duyet qua 8 cot lien ke cua mang SrcArr[/COLOR]
        For lC = 1 To 8
        [COLOR=#0000cd]  'Lay du lieu tung cot trong mang SrcArr khi thoa DK cho vao mang ResArr[/COLOR]
          ResArr(k, lC) = SrcArr(lR, lC)
          [COLOR=#0000cd]' Lay du lieu o cot 10 mang SrcArr cho vao cot 9 mang ResArr[/COLOR]
          ResArr(k, 9) = SrcArr(lR, 10)
       [COLOR=#0000cd] 'Duyet tiep den het 8 cot trong mang SrcArr[/COLOR]
        Next lC
     [COLOR=#0000cd] 'ket thuc dk[/COLOR]
      End If
    [COLOR=#0000cd]'Duyet tiep den het dong trong mang SrcArr[/COLOR]
    Next lR
  [COLOR=#0000cd]'Neu co du lieu thoa dk thi[/COLOR]
  If k Then
    With .[A7]
     [COLOR=#0000cd] 'Xoa vung co du lieu cu[/COLOR]
      .Resize(lR, 9).Clear
     [COLOR=#0000cd] ' Gan du lieu tu mang ResArr xuong sheet[/COLOR]
      .Resize(k, 9).Value = ResArr
      'Ke o vung du lieu
      .Resize(k + 1, 9).Borders.LineStyle = xlContinuous
     [COLOR=#0000cd] 'Nhap "Total" vao cot A dong cuoi cung du lieu[/COLOR]
      .Offset(k) = "Total:"
     [COLOR=#0000cd] 'Format dam dong cuoi cung[/COLOR]
      .Offset(k).Resize(, 9).Font.Bold = True
      [COLOR=#0000cd]'Tinh tong "Thu, Chi Ton" (dong cuoi)[/COLOR]
      .Offset(k, 5).Resize(, 3).FormulaR1C1 = "=SUM(R7C:R[-1]C)"
      [COLOR=#0000cd]'Format So tien dang "#,##0"[/COLOR]
      .Offset(, 5).Resize(k + 1, 3).NumberFormat = "#,##0"
     [COLOR=#0000cd] 'Format 2 cot ngay dang "dd/mm/yyyy"[/COLOR]
      .Offset(, 8).Resize(k).NumberFormat = "dd/mm/yyyy"
      .Resize(k).NumberFormat = "dd/mm/yyyy"
    End With
  Else
    [COLOR=#0000cd]'Khong thi thong bao khong co du lieu[/COLOR]
    MsgBox "No record found"
 [COLOR=#0000cd] 'Ket thuc dk[/COLOR]
  End If
End With
[COLOR=#0000cd]'Bat che do nhat man hinh[/COLOR]
Application.ScreenUpdating = True
End Sub

Xin cảm ơn bạnmhung12005
Mình đã hiểu đôi chút.
Mình có chỉnh sửa lại một số cái cho phù hợp với yêu cầu của mình. File chạy được, nhưng tương đối chậm, không biết là do đâu. Bạn xem lại và giúp mình khắc phục nguyên nhân này được không.?
 

File đính kèm

Upvote 0
Mọi người ơi, xem giải quyết hộ mình bài toán này nha.
Các cột A, giá trị tương ứng theo dòng là A, 2, 3,...
Cột B, giá trị tương ứng theo dòng là B, 12, 3, 6,...
Cột C, giá trị tương ứng theo dòng là C, 10, 3, 4,...
.......
Yêu cầu: Nếu tại F1=A thì sẽ lấy các giá trị dòng của cột A;
Nếu tại F1=B thì sẽ lấy các giá trị dòng của cột B; và sẽ tương ứng như vậy cho các cột khác.

Mình nghĩ nó đơn giản, nhưng làm hoài chả được. Hay do mình "gà" quá..hihi
 
Upvote 0
Mọi người ơi, xem giải quyết hộ mình bài toán này nha.
Các cột A, giá trị tương ứng theo dòng là A, 2, 3,...
Cột B, giá trị tương ứng theo dòng là B, 12, 3, 6,...
Cột C, giá trị tương ứng theo dòng là C, 10, 3, 4,...
.......
Yêu cầu: Nếu tại F1=A thì sẽ lấy các giá trị dòng của cột A;
Nếu tại F1=B thì sẽ lấy các giá trị dòng của cột B; và sẽ tương ứng như vậy cho các cột khác.

Mình nghĩ nó đơn giản, nhưng làm hoài chả được. Hay do mình "gà" quá..hihi

Mình đã chỉnh 1 chút code trong file và cũng làm luôn yêu cầu trên của bạn.

Bạn xem file nhé.
 

File đính kèm

Upvote 0
Nhờ các anh chị làm code giúp em cái này với ạ, em không rành excel lắm, dùng hàm thì biết sơ sơ chứ code thì chịu. Em cảm ơn anh chị. Nội dung cũng là truy xuất thông tin lịch sử khách hàng đã mua gì và còn nợ bao nhiêu tiền để thanh toán dựa theo mã khách hàng ở phần sheet data.
Cảm ơn anh chị lần nữa :)

Do không biết up trực tiếp file nên em gửi link mediafire
https://www.mediafire.com/download/lr17ks1z4yhigrn/XU LY CONG NO CUA HANG.rar
 
Upvote 0

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

Back
Top Bottom