kieuhungtlg
Thành viên mới
![](/diendan/data/PhoToDanhHieu/gold.gif)
- Tham gia
- 21/8/08
- Bài viết
- 3
- Được thích
- 0
Em có 1 file ví dụ về việc này như sau, loay hoay cả buổi sáng không thể nào làm được.
Đại ca cao thủ nào giúp em vụ này với, bên em gần 500 công nhân đi dò tìm thì lâu qúa
Thank!
=IF(ISERROR(VLOOKUP(B4,'Phong ke toan'!$B$5:$K$7,10,0)),VLOOKUP('Bang chuyen tien'!B4,'Don vi lai xe'!$B$5:$K$7,10,0),VLOOKUP(B4,'Phong ke toan'!$B$5:$K$7,10,0))
Làm "zì" cũng được, kết quả lấy ô thực lãnhEm có 1 file ví dụ về việc này như sau, loay hoay cả buổi sáng không thể nào làm được.
Đại ca cao thủ nào giúp em vụ này với, bên em gần 500 công nhân đi dò tìm thì lâu qúa
Thank!
Em có 1 file ví dụ về việc này như sau, loay hoay cả buổi sáng không thể nào làm được.
Đại ca cao thủ nào giúp em vụ này với, bên em gần 500 công nhân đi dò tìm thì lâu qúa
Thank!
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D4:D900")) Is Nothing Then
TimCNV Target
End If
End Sub
[B]Sub TimCNV(Targ As Range)[/B]
Dim Sh As Worksheet, Rng As Range, sRng As Range
For Each Sh In Worksheets
If Sh.Name <> "ATM" Then
Set Rng = Sh.Range(Sh.[B4], Sh.[B65500].End(xlUp))
Set sRng = Rng.Find(Targ.Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then _
Targ.Offset(, 1).Value = sRng.Offset(, 10).Value
End If
Next Sh
[B]End Sub[/B]
Để chắc ăn thì nên đặt name như thế này:Một phương pháp dùng 1 name duy nhất, name này là name động với Indirect() để lấy tên sheet với điều kiện:
- tên sheet = tên hoặc mã đơn vị (bộ phận)
- Mọi sheet bảng lương phải cùng cấu trúc
- Mỗi Bảng lương từ người đầu tiên đến người cuối cùng không có dòng trống, bắt đầu từ cùng 1 dòng (trong file là dòng 5)
- Dò tìm theo số TK, không dò tìm theo tên, như ý kiến của HYen17
- tên sheet ngắn gọn và không có khoảng trắng, như ý kiến của HYen17, dùng mã đơn vị để đặt tên sheet.
Công thức chung cho mọi người trong bảng chuyển tiền là:
=VLOOKUP(E4;Data;10;0)
Công thức name là:
=OFFSET(INDIRECT(BangCT!$D16&"!c5");0;0;COUNTA(INDIRECT(BangCT!$D16&"!$c$5:$c$600"));12)
Đặc điểm: bao nhiêu sheet bảng lương cũng được, không phải thay công thức.
Xem file kèm theo, và thử insert vài sheet mới cho vài đơn vị khác.
Có bạn nào thử giả lập đơn vị này có 14 bộ fận trong đó 12 bộ fận có tổng cộng là 120 người & 2 bộ fận còn lại 190 *2 người chưa
Nếu máy yếu như của mình chắc trước khi chạy fải kiếm cái gì lót dạ quá!
Khì, khì,. . . .
---Nhưng nếu là tôi, nếu dùng VBA thì dùng code copy paste từng sheet còn nhanh hơn.
---
Anh có thể viết cho em học hỏi được không? Mong là được![]()
---Được, nhưng thay vì copy paste, ta gán thẳng giá trị vào còn nhanh hơn nữa.
Đại khái là có bao nhiêu người lãnh lương của mỗi đơn vị, chép lần lượt vào sheet chuyển tiền. Việc này bảo đảm rằng mỗi tháng chỉ làm 1 lần, không bỏ sót, không dư không thiếu.
Nếu làm theo code của Bác HYen17 thì phải gõ lần lượt hoặc copy lần lượt từng em có lãnh lương vào sheet này, khi cột D (số TK) có thay đổi thì code chạy.
Giả sử tháng sau dùng lại file tháng trước thì làm sao đây? vì cột D không thay đổi, code không chạy.
Vả lại, khi dùng file tháng trước, thì nhân sự có thay đổi chút ít, lại phải tìm xem em nào nghỉ để xóa dòng.
Ghi chú: Vẫn phải có 1 cột số TK trên mỗi bảng lương, thêm 1 cột bộ phận nữa. Ngoài ra tên sheet cũng là tên đơn vị. Hoặc thêm cột đơn vị cũng được. File kèm theo là 4 sheet , cộng là trên 2200 NV, chạy không kịp nhận ra.
Range("A4:F10000").ClearContents
'Xóa sheet làm lại'
BeginR = 4
'Dòng đầu tiên để chép là dòng 4'
For Each Sh In Worksheets
'Với mỗi sheet trong workbook'
If Sh.Name <> "BangCT" Then
'Nếu tên sheet khác với BangCT'
RowsCount = Sh.[c5].End(xlDown).Row - 4
'Số dòng = số thứ tự dòng cuối chứa dữ liệu - 4'
Range("B" & BeginR & ":B" & RowsCount + BeginR - 1) = Sh.Range("B5:B" & RowsCount + 5).Value
'Cột B tính từ dòng đầu đến dòng đầu + số dòng trên - 1 sẽ bằng cột B từ B5 đến dòng cuối của sheet đang xét'
Range("C" & BeginR & ":C" & RowsCount + BeginR - 1) = Sh.Range("D5:D" & RowsCount + 5).Value
'Cột C thì bằng cột D'
Range("D" & BeginR & ":D" & RowsCount + BeginR - 1) = Sh.Name
'Cột D thì bằng tên sheet đang xét cũng chính là đơn vị.'
Range("E" & BeginR & ":E" & RowsCount + BeginR - 1) = Sh.Range("C5:C" & RowsCount + 5).Value
' Cột E thì bằng cột C'
Range("F" & BeginR & ":F" & RowsCount + BeginR - 1) = Sh.Range("M5:M" & RowsCount + 5).Value
'Cột F thì bằng cột M'
BeginR = BeginR + RowsCount
'Dòng bắt đầu mới bằng dòng bắt đầu cũ + số dòng sheet đang xét'
End If
Next Sh
'xét sheet kế'
EndR = [B10000].End(xlUp).Row
'Xét hết các sheet thì xem dòng cuối là dòng mấy'
Range("A4:A" & EndR).Value = Evaluate("ROW(R:R)")
'Cột A từ dòng 4 đến dòng cuối bằng giá trị hàm Row() tức là uýnh số TT'
Range("F" & EndR + 1).FormulaR1C1 = "=SUM(R4C:R[-1]C)"
'ô kế dưới dòng cuối của cột F sẽ có công thức tổng từ F4 đến F kế trên'
Function GPELookup(Ds As String, Tk As String)
Dim Ten,i
Dim c As Range
Dim Sh As Worksheet
Ten = Split(Ds, ";")
For i = 0 To UBound(Ten) Step 2
Set Sh = Sheets(Ten(i))
Set c = Sh.Cells.Find(What:=Tk, LookAt:=xlWhole)
If Not c Is Nothing Then
GPELookup = c.Offset(, Val(Ten(i + 1))).Value
Exit Function
End If
Next
GPELookup = 0
End Function
---Nếu vẫn muốn dùng công thức Excel, không dùng VBA, thì thêm 1 name nữa là tiêu đề:
Tieude = OFFSET(Data;-2;0;1
Công thức sẽ là: G4 =VLOOKUP(E4;Data;MATCH("Thực lĩnh";Tieude;0);0)
Có thể đưa luôn MATCH("Thực lĩnh";Tieude;0) vào name, nhưng để vậy cho dễ hiểu. Thí dụ:
Cot = MATCH("Thực lĩnh";OFFSET(Data;-2;0;1;0)
H4 =VLOOKUP(E4;Data;Cot;0)
Mượn file của Sealand, (đã chèn cột xóa cột lung tung)
Sub LietkeCNV()
Application.ScreenUpdating = False
Dim Sh As Worksheet, Rng As Range, sRng As Range
Range("A4:F10000").ClearContents
BeginR = 4
For Each Sh In Worksheets
If Sh.Name <> "BangCT" Then
RowsCount = Sh.[c5].End(xlDown).Row - 4
cot = Application.Match("Th" & ChrW(7921) & "c l" & ChrW(297) & "nh", Sh.Range("A3:T3"), 0)
Range("B" & BeginR & ":B" & RowsCount + BeginR - 1) = Sh.Range("B5:B" & RowsCount + 5).Value
Range("C" & BeginR & ":C" & RowsCount + BeginR - 1) = Sh.Range("D5:D" & RowsCount + 5).Value
Range("D" & BeginR & ":D" & RowsCount + BeginR - 1) = Sh.Name
Range("E" & BeginR & ":E" & RowsCount + BeginR - 1) = Sh.Range("C5:C" & RowsCount + 5).Value
Range("F" & BeginR & ":F" & RowsCount + BeginR - 1) = Sh.Range(Sh.Cells(5, cot), Sh.Cells(RowsCount + 5, cot)).Value
BeginR = BeginR + RowsCount
End If
Next Sh
EndR = [B10000].End(xlUp).Row
Range("A4:A" & EndR).Value = Evaluate("ROW(R:R)")
Range("F" & EndR + 1).FormulaR1C1 = "=SUM(R4C:R[-1]C)"
Application.ScreenUpdating = True
End Sub
---Code cũng vậy, chỉ sửa chỉ số cột "Thực lĩnh" của các sheet bảng lương bằng với match(), các cột khác để nguyên code.
Cách đơn giản:---
Vậy "Thực lãnh" cũng không được phải không anh? Anh giúp em chỉ cần lấy 2 ký tự "Th" là tốt rồi. Thú thật em không rành các hàm trong VBA![]()
PHP:Range("A4:F10000").ClearContents 'Xóa sheet làm lại' BeginR = 4 'Dòng đầu tiên để chép là dòng 4' For Each Sh In Worksheets 'Với mỗi sheet trong workbook' If Sh.Name <> "BangCT" Then 'Nếu tên sheet khác với BangCT' RowsCount = Sh.[c5].End(xlDown).Row - 4 'Số dòng = số thứ tự dòng cuối chứa dữ liệu - 4' Range("B" & BeginR & ":B" & RowsCount + BeginR - 1) = Sh.Range("B5:B" & RowsCount + 5).Value 'Cột B tính từ dòng đầu đến dòng đầu + số dòng trên - 1 sẽ bằng cột B từ B5 đến dòng cuối của sheet đang xét' --- [/QUOTE] Range("B" & BeginR & ":B" & RowsCount + BeginR - 1) = Sh.Range("B5:B" & RowsCount + [B][COLOR=red]5[/COLOR][/B]).Value Anh vui lòng cho em hỏi sao lại cộng 5 mà không là 4 ?, em +-+-+-+