Nhờ các anh chị giúp file cell mở rộng vùng tìm kiếm (1 người xem)

Liên hệ QC

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

alibaba2209

Thành viên thường trực
Tham gia
4/12/10
Bài viết
283
Được thích
13
anh giải thích dùm vba ở sheep 2 và mở rộng vùng bảng để thay đổi bảng biểu
 
ở sheep - TKThep >> ô hàng kiểu thanh đánh loại thép sẽ nhẩy tự động coppy từ bên sheep - ThuVien sang
 
Upvote 0
anh có thể diễn giải chi tiết dùm em được không:
'By Luu Trung Kien
'Date 4/2010
'HAM TIM KIEM VI TRI CUA KIEU THEP BEN SHEET THU VIEN
'****************************************************************************************************
Function FIND_INDEX_KieuThep(ByVal FindKT As String) As Long
Const Start_Index_Data = 5
Dim Rng As Range
If Trim(FindKT) <> "" Then
With Sheet1.Range("C" & Start_Index_Data & ":C" & Sheet1.UsedRange.Rows.Count)
Set Rng = .Find(what:=FindKT, _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FIND_INDEX_KieuThep = Rng.Row
Else
FIND_INDEX_KieuThep = 0
End If
End With
End If
End Function
'THU TUC COPY TU SHEET THU VIEN SANG BANG THONG KE THEP
'****************************************************************************************************
Private Sub Worksheet_Change(ByVal Target As Range)
Const start_index = 7
Dim Row_Index As Long
Dim Row_Data As Long
Dim Row_Height As Long
Dim j As Long
If InStr(Target.Address, "$C$") > 0 Then 'Vi tri cua Cell tai cot C
If Target.Count <> 1 Then Exit Sub 'Neu chon lon hon thi bo qua
Row_Data = FIND_INDEX_KieuThep(Range("C" & Target.Row))
If Range("C" & Target.Row) <> "" And Row_Data > 0 Then
Row_Index = Target.Row
Row_Height = Sheet1.Range("D" & Row_Data).RowHeight
Sheet2.Range("D" & Row_Index).RowHeight = Row_Height
Sheet1.Activate
Sheet1.Range("D" & Row_Data & ":R" & Row_Data).Select
Application.CutCopyMode = False
Selection.Copy
Sheet2.Select
Sheet2.Range("D" & Row_Index).Select
ActiveSheet.Paste
Sheet2.Range("C" & Row_Index + 1).Select
Else
End If
End If
End Sub
 
Upvote 0
anh có thể diễn giải chi tiết dùm em được không:
'By Luu Trung Kien
'Date 4/2010
'HAM TIM KIEM VI TRI CUA KIEU THEP BEN SHEET THU VIEN
'****************************************************************************************************
Function FIND_INDEX_KieuThep(ByVal FindKT As String) As Long
Const Start_Index_Data = 5
Dim Rng As Range
If Trim(FindKT) <> "" Then
With Sheet1.Range("C" & Start_Index_Data & ":C" & Sheet1.UsedRange.Rows.Count)
Set Rng = .Find(what:=FindKT, _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FIND_INDEX_KieuThep = Rng.Row
Else
FIND_INDEX_KieuThep = 0
End If
End With
End If
End Function
'THU TUC COPY TU SHEET THU VIEN SANG BANG THONG KE THEP
'****************************************************************************************************
Private Sub Worksheet_Change(ByVal Target As Range)
Const start_index = 7
Dim Row_Index As Long
Dim Row_Data As Long
Dim Row_Height As Long
Dim j As Long
If InStr(Target.Address, "$C$") > 0 Then 'Vi tri cua Cell tai cot C
If Target.Count <> 1 Then Exit Sub 'Neu chon lon hon thi bo qua
Row_Data = FIND_INDEX_KieuThep(Range("C" & Target.Row))
If Range("C" & Target.Row) <> "" And Row_Data > 0 Then
Row_Index = Target.Row
Row_Height = Sheet1.Range("D" & Row_Data).RowHeight
Sheet2.Range("D" & Row_Index).RowHeight = Row_Height
Sheet1.Activate
Sheet1.Range("D" & Row_Data & ":R" & Row_Data).Select
Application.CutCopyMode = False
Selection.Copy
Sheet2.Select
Sheet2.Range("D" & Row_Index).Select
ActiveSheet.Paste
Sheet2.Range("C" & Row_Index + 1).Select
Else
End If
End If
End Sub
Bạn thay toàn bộ code trên bằng code sau
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Column = 3 Then _
    Sheets("ThuVien").[C:R].Rows(WorksheetFunction.Match(Target, Sheets("ThuVien").[C:C], 0)).Copy Target
End Sub
Trong code này, ta chọn vùng dữ liệu ừ cộT C đến R của sheet!ThuVien, ứng với vị trí (Row) mà target Match với giá trị của cộT C . Bạn có thể điều chỉnh vùng C:R nếu cần
 
Upvote 0
anh giải thích chi tiết code anh vừa viết cho em với anh nginh
user-online.png
Thà
 
Upvote 0
anh giải thích chi tiết code anh vừa viết cho em với anh nginh

Nếu ô bạn gõ dữ liệu (tức target) nằm ở cột số 3 (tức cột C) thì excel sẽ tìm đến khoảng cột [C:R] trong sheet ThuVien ngó qua cột C coi có ai giống với giá trị trong ô target (tức Match) thì copy dữ liệu của hàng tương ứng với ai đó dán qua ô target bên sheet TKThep giống như bạn làm thủ công vậy thôi
 
Upvote 0
cho em hỏi tý! sao em coppy code mới này vào thoát ra nó lại ko lưu nhỉ
 
Upvote 0
làm sao để cho khi thay đổi dữ liệu bên Thuvien - sheet bên kia sẽ nhẩy theo anh nhỉ
 
Upvote 0
làm sao để cho khi thay đổi dữ liệu bên Thuvien - sheet bên kia sẽ nhẩy theo anh nhỉ
em lưu được rồi chuyển về cell 2003
 
Upvote 0
cũng được em cần số liệu nhây thôi anh chỉ dùm em với
 
Upvote 0
................................................................
 
Lần chỉnh sửa cuối:
Upvote 0
..............................................
 
Lần chỉnh sửa cuối:
Upvote 0
Private Sub Worksheet_Change(ByVal Target As Range)
On [COLOR=#009900 !important]Error[/COLOR] Resume Next
If Target.Column = 3 Then _
[COLOR=#009900 !important]Sheets[/COLOR]("ThuVien").[C:R].Rows(WorksheetFunction.[COLOR=#009900 !important]Match[/COLOR](Target, Sheets("ThuVien").[C:C], 0)).Copy Target
End Sub

anh giải thích cặn kẽ từ trên xuống của code cho em với.. em mới nên chưa biết >> như "Private Sub Worksheet_Change(ByVal Target As Range)" nghĩa là gì
Private Sub Worksheet_Change(ByVal Target As Range) : Thủ tục dành riêng (Private Sub) cho Worksheet (không chạy trên các sheet khác) khi thay đổi (Change) giá trị (ByVal Target) của mt vùng (Range) trong Worksheet
On Error Resume Next : Khi gặp lỗi (On Error) thì bqua, đi tiếp (Resume Next) ví dụ khi bạn gõ ký hiệu thanh thép sai hoc xoá, delete target ...
 
Upvote 0
anh sửa dùm code khi thay đổi sheet "Thuvien" bên sheet "TKThep" thay đổi với..
 
Upvote 0

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

Back
Top Bottom