Code Copy Dữ Liệu (1 người xem)

[vuongtoituonglai]

Xin Chào cà nhà GPE!
Form tôi sử dung hằng ngày nay có sự yêu cầu từ cấp trên là phải chỉnh sửa lại, tôi gặp không it khó khăn khi thay đổi form nên nhờ các anh chị và các bạn xem và chỉnh sửa giúp tôi để tôi đỡ vất vã một phần trong công việc. Tất cả những đều có trong file đính kèm
Anh chị và các bạn xem sheet có tên NS trước nhé
Chân thành cám ơn

 

[vuongtoituonglai]

Xin Chào cà nhà GPE!
Form tôi sử dung hằng ngày nay có sự yêu cầu từ cấp trên là phải chỉnh sửa lại, tôi gặp không it khó khăn khi thay đổi form nên nhờ các anh chị và các bạn xem và chỉnh sửa giúp tôi để tôi đỡ vất vã một phần trong công việc. Tất cả những đều có trong file đính kèm
Anh chị và các bạn xem sheet có tên NS trước nhé
Chân thành cám ơn

Có lẻ mình giải thích lằn nhằng nên các bạn chưa rỏ nên mình giải thích lại để nhận được sự trợ giúp từ các bạn
.Copy MSNV từ A4 trở xuống phụthuộc vào bộ phận.
VD: Cell B1 chọn là "Y -G4" thì chỉ copy MSNV của nhữngngười thuộc bộ phận này qua sheet có tên A3 hoặc A4 dòng số 28(Copy qua sheetcó tên A3 hay A4 phụ thuộc vào cell B2, Cell B2 chọn A3 thì copy qua sheet A3và ngược lại)
. Tương tự như vậy copy CÔNG VIỆCtừ B4 trở xuống diều kiện cũng giống như trên qua dòng 30 của sheet A3 hoặc A
.Tương tự như vậy copy TÊN từ C4 trở xuống điều kiện cũng giống như trênqua dòng 27 của sheet A3 hoặc A.
Rất mong nhận được sự giúp đỡ

 

[SA_DQ]

Trước tiên mình rất biết ơn, nếu bạn cho biết lí do buộc fải trộn 2 ô theo hàng;

Nếu lí do chưa chính đáng lắm thì bạn không nên trộn ô; Vì lẽ VBA rất kị chuyện trộn ô đó nha bạn!

 

[vuongtoituonglai]

Trước tiên mình rất biết ơn, nếu bạn cho biết lí do buộc fải trộn 2 ô theo hàng;

Nếu lí do chưa chính đáng lắm thì bạn không nên trộn ô; Vì lẽ VBA rất kị chuyện trộn ô đó nha bạn!

Cảm ơn bạn đã quan tâm.
Sở dĩ có chuyện trộn ô là mỗi một nhân viên sẽ có 2 Ô, tương ứng 2 cột, một cột sẽ tô màu cho mục tiêu và một cột sẽ tô màu cho thực tích. Mình cũng rất ngại khi phải trộn ô nhưng không còn cách bạn ơi.

 

[vuongtoituonglai]

Trước tiên mình rất biết ơn, nếu bạn cho biết lí do buộc fải trộn 2 ô theo hàng;

Nếu lí do chưa chính đáng lắm thì bạn không nên trộn ô; Vì lẽ VBA rất kị chuyện trộn ô đó nha bạn!

Bạn HYen17 đã bó tay vụ này sao, có bạn nào cao tay ấn giúp mình vụ này với.

 

[HungQuoc49]

Có lẻ mình giải thích lằn nhằng nên các bạn chưa rỏ nên mình giải thích lại để nhận được sự trợ giúp từ các bạn
.Copy MSNV từ A4 trở xuống phụthuộc vào bộ phận.
VD: Cell B1 chọn là "Y -G4" thì chỉ copy MSNV của nhữngngười thuộc bộ phận này qua sheet có tên A3 hoặc A4 dòng số 28(Copy qua sheetcó tên A3 hay A4 phụ thuộc vào cell B2, Cell B2 chọn A3 thì copy qua sheet A3và ngược lại)
. Tương tự như vậy copy CÔNG VIỆCtừ B4 trở xuống diều kiện cũng giống như trên qua dòng 30 của sheet A3 hoặc A
.Tương tự như vậy copy TÊN từ C4 trở xuống điều kiện cũng giống như trênqua dòng 27 của sheet A3 hoặc A.
Rất mong nhận được sự giúp đỡ

Thử đoạn code lọc dữ liệu xem sao

Public Sub Loc()
Dim DL, BoPhan, TenSh, TenNV(), MSNV(), CongTac()
Dim r As Long, i

With Sheets("NS")
DL = .Range("A4", .Range("E1000000").End(xlUp))
BoPhan = .Range("B1")
TenSh = .Range("B2")
End With

ReDim TenNV(1 To UBound(DL) * 2), MSNV(1 To UBound(DL) * 2), CongTac(1 To UBound(DL) * 2)

For r = 1 To UBound(DL)
If DL(r, 5) = BoPhan Then
i = i + 1
TenNV(i * 2 - 1) = DL(r, 3): MSNV(i * 2 - 1) = DL(r, 1): CongTac(i * 2 - 1) = DL(r, 2)
End If
Next r

With Sheets(TenSh)
.Range("C27:XFD30").ClearContents
.Range("C27").Resize(1, i * 2) = TenNV
.Range("C28").Resize(1, i * 2) = MSNV
.Range("C30").Resize(1, i * 2) = CongTac
End With
End Sub

 

[vuongtoituonglai]

Thử đoạn code lọc dữ liệu xem sao

Public Sub Loc()
Dim DL, BoPhan, TenSh, TenNV(), MSNV(), CongTac()
Dim r As Long, i

With Sheets("NS")
DL = .Range("A4", .Range("E1000000").End(xlUp))
BoPhan = .Range("B1")
TenSh = .Range("B2")
End With

ReDim TenNV(1 To UBound(DL) * 2), MSNV(1 To UBound(DL) * 2), CongTac(1 To UBound(DL) * 2)

For r = 1 To UBound(DL)
If DL(r, 5) = BoPhan Then
i = i + 1
TenNV(i * 2 - 1) = DL(r, 3): MSNV(i * 2 - 1) = DL(r, 1): CongTac(i * 2 - 1) = DL(r, 2)
End If
Next r

With Sheets(TenSh)
.Range("C27:XFD30").ClearContents
.Range("C27").Resize(1, i * 2) = TenNV
.Range("C28").Resize(1, i * 2) = MSNV
.Range("C30").Resize(1, i * 2) = CongTac
End With
End Sub

Cảm ơn bạn đã giúp đỡ. Cho mình hỏi them một tí nhé: Sao dòng số 29 của sheet A3 và A4 mỗi lần chạy code thì công thức trong dòng 29 này bị xóa hết nên không Insert được hình vào, vậy chỉnh code như thế nào để mỗi lần chạy code thì dòng số 29 không bị xóa. Cảm ơn bạn

 

[HungQuoc49]

Cảm ơn bạn đã giúp đỡ. Cho mình hỏi them một tí nhé: Sao dòng số 29 của sheet A3 và A4 mỗi lần chạy code thì công thức trong dòng 29 này bị xóa hết nên không Insert được hình vào, vậy chỉnh code như thế nào để mỗi lần chạy code thì dòng số 29 không bị xóa. Cảm ơn bạn

Sửa lại không xóa dữ liệu dòng 29

Public Sub Loc()
Dim DL, BoPhan, TenSh, TenNV(), MSNV(), CongTac()
Dim r As Long, i

With Sheets("NS")
DL = .Range("A4", .Range("E1000000").End(xlUp))
BoPhan = .Range("B1")
TenSh = .Range("B2")
End With

ReDim TenNV(1 To UBound(DL) * 2), MSNV(1 To UBound(DL) * 2), CongTac(1 To UBound(DL) * 2)

For r = 1 To UBound(DL)
If DL(r, 5) = BoPhan Then
i = i + 1
TenNV(i * 2 - 1) = DL(r, 3): MSNV(i * 2 - 1) = DL(r, 1): CongTac(i * 2 - 1) = DL(r, 2)
End If
Next r

With Sheets(TenSh)
.Range("C27:XFD28").ClearContents: .Range("C30:XFD30").ClearContents '<--Sửa chỗ này
.Range("C27").Resize(1, i * 2) = TenNV
.Range("C28").Resize(1, i * 2) = MSNV
.Range("C30").Resize(1, i * 2) = CongTac
End With
End Sub

 

[vuongtoituonglai]

Sửa lại không xóa dữ liệu dòng 29

Public Sub Loc()
Dim DL, BoPhan, TenSh, TenNV(), MSNV(), CongTac()
Dim r As Long, i

With Sheets("NS")
DL = .Range("A4", .Range("E1000000").End(xlUp))
BoPhan = .Range("B1")
TenSh = .Range("B2")
End With

ReDim TenNV(1 To UBound(DL) * 2), MSNV(1 To UBound(DL) * 2), CongTac(1 To UBound(DL) * 2)

For r = 1 To UBound(DL)
If DL(r, 5) = BoPhan Then
i = i + 1
TenNV(i * 2 - 1) = DL(r, 3): MSNV(i * 2 - 1) = DL(r, 1): CongTac(i * 2 - 1) = DL(r, 2)
End If
Next r

With Sheets(TenSh)
.Range("C27:XFD28").ClearContents: .Range("C30:XFD30").ClearContents '<--Sửa chỗ này
.Range("C27").Resize(1, i * 2) = TenNV
.Range("C28").Resize(1, i * 2) = MSNV
.Range("C30").Resize(1, i * 2) = CongTac
End With
End Sub

Cảm ơn bạn, tất cả đã tốt rồi