Cần giúp viết Code Cut and paste ở cột E sang cột khác (Điều kiện là cùng Tháng năm) (1 người xem)

[hung2412]

Chào các bạn GPE!
Nhờ các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Cột B là cột ngày tháng năm. Cột E là cột số tiền. Từ cột F đến cột H có dòng tiêu đề là tháng năm. Có Code nào cắt (Cut and paste) số tiền ở cột E (Chỉ những ô nào có số tiền thì mới cut and paste) sang cột F đến cột H cùng dòng với nhau (Thỏa mãn điều kiện Tháng năm ở cột B tương ứng với dòng tiêu đề là tháng năm ở cột F đến cột H)?
Ví dụ: Ô B7 có tháng năm là 01/07/2014 => Cut and paste số tiền ở ô E7 (Số tiền là 18.212.800) (Cùng dòng với ô B7) đến ô F7 (Vì ô này thuộc cột F có tiêu đề là T07/2014 cùng tháng năm và cùng dòng với ô B7).
Mong các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Có 01 File đính kèm.

 

[nghiaphuc]

Chào các bạn GPE!
Nhờ các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Cột B là cột ngày tháng năm. Cột E là cột số tiền. Từ cột F đến cột H có dòng tiêu đề là tháng năm. Có Code nào cắt (Cut and paste) số tiền ở cột E (Chỉ những ô nào có số tiền thì mới cut and paste) sang cột F đến cột H cùng dòng với nhau (Thỏa mãn điều kiện Tháng năm ở cột B tương ứng với dòng tiêu đề là tháng năm ở cột F đến cột H)?
Ví dụ: Ô B7 có tháng năm là 01/07/2014 => Cut and paste số tiền ở ô E7 (Số tiền là 18.212.800) (Cùng dòng với ô B7) đến ô F7 (Vì ô này thuộc cột F có tiêu đề là T07/2014 cùng tháng năm và cùng dòng với ô B7).
Mong các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Có 01 File đính kèm.

Thử code này xem sao:
[GPECODE=vb]Sub CutAndPaste()
Dim Cll As Range, Des As Range
On Error Resume Next
For Each Cll In Sheet1.[E5:E1000].SpecialCells(2)
Set Des = Sheet1.Range("F4:IV4").Find(Format(Cll.Offset(, -3), "Tmm/yyyy"), , , xlWhole).Offset(Cll.Row - 4)
If Not Des Is Nothing Then
Cll.Copy Des
Cll.ClearContents
End If
Next
End Sub[/GPECODE]

 

[hung2412]

[GPECODE=vb]
Cll.Copy Des
Cll.ClearContents[/GPECODE]

Đoạn này có thể rút thành:
[GPECODE=vb]
Cll.Cut Des[/GPECODE]

 

[hung2412]

Code cùi:
[gpecode1=vb]Sub CutAndPaste()
Dim rng As Range, cll As Range
For Each cll In Range([F4], [IV4].End(xlToLeft))
For Each rng In Range([E5], [E65536].End(xlUp)).SpecialCells(2)
If Right(rng.Offset(, -3), 7) = Right(cll, 7) Then
rng.Cut Cells(rng.Row, cll.Column)
End If
Next
Next
End Sub[/gpecode1]