quoc nhat
Thành viên tiêu biểu

- Tham gia
- 8/3/12
- Bài viết
- 567
- Được thích
- 43
- Nghề nghiệp
- cán bộ ngành y tế

giúp em với mọi người ơi!
Public Sub Bate()
Dim sArr(), dArr(1 To 10, 1 To 25), tArr(), I As Long, J As Long, DK As Long, K As Long
With Sheets("DATA")
sArr = .Range(.[A3], .[Y65536].End(xlUp)).Value
End With
DK = Sheets("xuat kho").[N49].Value
For I = 1 To UBound(sArr, 1)
If sArr(I, 7) = DK Then
K = K + 1
For J = 1 To 25
dArr(K, J) = sArr(I, J)
Next J
End If
Next I
ReDim tArr(1 To K, 1 To 10)
With Sheets("xuat kho")
.[D53].Value = dArr(1, 4)
.[J53].Value = IIf(dArr(1, 2) <> Empty, dArr(1, 2), dArr(1, 3))
.[D55].Value = dArr(1, 1)
.[J55].Value = IIf(dArr(1, 2) <> Empty, "Nam", "Nu")
.[D57].Value = dArr(1, 8)
.[K59].Value = dArr(1, 6)
.[D53].Value = dArr(1, 4)
For I = 1 To K
tArr(I, 1) = dArr(I, 23)
tArr(I, 3) = dArr(I, 25)
tArr(I, 7) = "=VLOOKUP(RC[-6],BangGia,3,0)"
tArr(I, 8) = dArr(I, 24)
tArr(I, 9) = "=VLOOKUP(RC[-8],BangGia,4,0)"
tArr(I, 10) = "=RC[-1]*RC[-2]"
Next I
.[B63:L68].ClearContents
.[B63].Resize(K, 10) = tArr
End With
End Sub

Cảm ơn anh đã nhận xét:1/ Bạn có làm thử bằng thủ công chưa?
2/ Các cột dữ liệu bên Data không đủ để điền đầy đủ cho bảng biểu bên Xuat Kho như Hạn dùng từ - Đến ... có đâu mà lấy.
3/ Dữ liệu bên Data kiểu đó thì khó cho việc lấy dữ liệu sang sheet Xuat Kho vì dòng có dòng không như cột số phiếu chẳng hạn, (cột 7 - Data). Nhìn bằng mắt thì bạn tự hiểu dòng nào không có dữ liệu thì "như trên" nhưng Excel gặp chuyện này làm rối rắm thêm.
Gặp dữ liệu không chuẩn nên rất nhiều người xem qua rồi ... đi luôn.
Tôi nghĩ rất nhiều người "ngứa tay" nhưng cũng "chạy".

em có dùng thử nhưng khi thay đổi số phiếu và nhấn nút tìm thì không thấy nó nhúc nhích gì cả1/ Bạn có làm thử bằng thủ công chưa?
2/ Các cột dữ liệu bên Data không đủ để điền đầy đủ cho bảng biểu bên Xuat Kho như Hạn dùng từ - Đến ... có đâu mà lấy.
3/ Dữ liệu bên Data kiểu đó thì khó cho việc lấy dữ liệu sang sheet Xuat Kho vì dòng có dòng không như cột số phiếu chẳng hạn, (cột 7 - Data). Nhìn bằng mắt thì bạn tự hiểu dòng nào không có dữ liệu thì "như trên" nhưng Excel gặp chuyện này làm rối rắm thêm.
Gặp dữ liệu không chuẩn nên rất nhiều người xem qua rồi ... đi luôn.
Tôi nghĩ rất nhiều người "ngứa tay" nhưng cũng "chạy".
-----------------------
Tặng bạn Sub này cho nút Sửa Phiếu.
Có điền thêm cho đầy cột Số Phiếu
Chuyện Lưu lại thì ... chưa biết.
PHP:Public Sub Bate() Dim sArr(), dArr(1 To 10, 1 To 25), tArr(), I As Long, J As Long, DK As Long, K As Long With Sheets("DATA") sArr = .Range(.[A3], .[Y65536].End(xlUp)).Value End With DK = Sheets("xuat kho").[N49].Value For I = 1 To UBound(sArr, 1) If sArr(I, 7) = DK Then K = K + 1 For J = 1 To 25 dArr(K, J) = sArr(I, J) Next J End If Next I ReDim tArr(1 To K, 1 To 10) With Sheets("xuat kho") .[D53].Value = dArr(1, 4) .[J53].Value = IIf(dArr(1, 2) <> Empty, dArr(1, 2), dArr(1, 3)) .[D55].Value = dArr(1, 1) .[J55].Value = IIf(dArr(1, 2) <> Empty, "Nam", "Nu") .[D57].Value = dArr(1, 8) .[K59].Value = dArr(1, 6) .[D53].Value = dArr(1, 4) For I = 1 To K tArr(I, 1) = dArr(I, 23) tArr(I, 3) = dArr(I, 25) tArr(I, 7) = "=VLOOKUP(RC[-6],BangGia,3,0)" tArr(I, 8) = dArr(I, 24) tArr(I, 9) = "=VLOOKUP(RC[-8],BangGia,4,0)" tArr(I, 10) = "=RC[-1]*RC[-2]" Next I .[B63:L68].ClearContents .[B63].Resize(K, 10) = tArr End With End Sub
em có dùng thử nhưng khi thay đổi số phiếu và nhấn nút tìm thì không thấy nó nhúc nhích gì cả
Bạn muốn gán nó vào nút tìm thì gán lại.Tặng bạn Sub này cho nút Sửa Phiếu.