=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ãnh
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:
---
Anh có thể viết cho em học hỏi được không? Mong là được
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
;0)---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
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---
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
Nhẩm nhẩm cho ra kết quả í mà. Nhưng lúc nhẩm nhẩm lại lần 2 thấy sai, sửa vế trước dấu bằng mà quên sửa phía sau dấu bằng. Khà khà khà. Tâm sửa lại dùm nhen.
---
Sealand đã viết:
HYen đã viết:
---
Bản gốc của tác giả là 1 bảng liệt kê danh sách chuyển tiền cho từng người, có lẽ là bản chuyển cho ngân hàng.tam8678 đã viết:
Dạ, Bác nói lần này chí phải!
---
---
Anh nói thì em nghe, em có giỏi giang gì đâu mà lạm dụng (chỉ cố theo bài của anh
). Mong anh hiểu.
endr = [F10000].End(xlUp).RowEndR = BeginR - 1 'Range("C" & RowsCount + BeginR & ":F" & RowsCount + BeginR).Font.Bold = True
