vuongdanhthang
Thành viên mới
- Tham gia
- 1/8/13
- Bài viết
- 12
- Được thích
- 2
Chào các anh chị,
Em đang làm bên xây dựng, làm công việc bóc tách khối lượng thường xuyên.
Em muốn có một bảng tính mẫu sử dụng VBA để làm cho thao tác bóc tách khối lượng nhanh hơn. Lần mò trên diễn đàn thấy một file excel có code VBA của anh Lưu Trung Kiên viết về bảng thống kê thép; em áp dụng nó để lập một bảng tính excel cho mình.
File excel của em có 2 sheet: 1. ThuVien; 2. BTCP. Trong sheet BTCP khi đánh số thứ tự của Kiểu có trong sheet Thuvien thì code sẽ copy các dòng tương ứng từ sheet ThuVien sang sheet BTCP.
Nhưng hạn chế của code anh Kiên là chỉ có một sheet (BTCP - đang là sheet có số thự tự 2), em muốn file của mình có nhiều sheet mà vẫn tự động update code như sheet BTCP thì làm thế nào? Em không biết VBA nên không biết viết code thế nào; mục đích là làm cho "SHEET2" trong code tự động lấy số thứ tự của sheet khi em copy sheet BTCP ra thành nhiều sheet nữa: sheet3, sheet4, sheet5,... (em có thể xóa bất kỳ sheet nào - trừ sheet thư viện cũng không ảnh hưởng).
Em có kèm theo code bên dưới:
Em đang làm bên xây dựng, làm công việc bóc tách khối lượng thường xuyên.
Em muốn có một bảng tính mẫu sử dụng VBA để làm cho thao tác bóc tách khối lượng nhanh hơn. Lần mò trên diễn đàn thấy một file excel có code VBA của anh Lưu Trung Kiên viết về bảng thống kê thép; em áp dụng nó để lập một bảng tính excel cho mình.
File excel của em có 2 sheet: 1. ThuVien; 2. BTCP. Trong sheet BTCP khi đánh số thứ tự của Kiểu có trong sheet Thuvien thì code sẽ copy các dòng tương ứng từ sheet ThuVien sang sheet BTCP.
Nhưng hạn chế của code anh Kiên là chỉ có một sheet (BTCP - đang là sheet có số thự tự 2), em muốn file của mình có nhiều sheet mà vẫn tự động update code như sheet BTCP thì làm thế nào? Em không biết VBA nên không biết viết code thế nào; mục đích là làm cho "SHEET2" trong code tự động lấy số thứ tự của sheet khi em copy sheet BTCP ra thành nhiều sheet nữa: sheet3, sheet4, sheet5,... (em có thể xóa bất kỳ sheet nào - trừ sheet thư viện cũng không ảnh hưởng).
Em có kèm theo code bên dưới:
Mã:
'By Luu Trung Kien
'Date 4/2010
'HAM TIM KIEM VI TRI CUA KIEU BEN SHEET THU VIEN
'****************************************************************************************************
Function FIND_INDEX_Kieu(ByVal FindK As String) As Long
Const Start_Index_Data = 5
Dim Rng As Range
If Trim(FindK) <> "" Then
With Sheet1.Range("C" & Start_Index_Data & ":C" & Sheet1.UsedRange.Rows.Count)
Set Rng = .Find(what:=FindK, _
after:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FIND_INDEX_Kieu = Rng.Row
Else
FIND_INDEX_Kieu = 0
End If
End With
End If
End Function
'THU TUC COPY TU SHEET THU VIEN SANG SHEET MOI
'****************************************************************************************************
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_Kieu(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
[COLOR=#ff0000]Sheet2[/COLOR].Range("D" & Row_Index).RowHeight = Row_Height
Sheet1.Activate
Sheet1.Range("D" & Row_Data & ":M" & Row_Data).Select
Application.CutCopyMode = False
Selection.Copy
[COLOR=#ff0000]Sheet2[/COLOR].Select
[COLOR=#ff0000]Sheet2[/COLOR].Range("D" & Row_Index).Select
ActiveSheet.Paste
[COLOR=#ff0000]Sheet2[/COLOR].Range("C" & Row_Index + 1).Select
Else
End If
End If
End Sub
. 
