Copy bên phải ô có màu (2 người xem)

[toandiennuoc123]

Nhờ các bạn tạo Sub giúp tôi, xem chi tiết trong file đính kèm

 

[mhung12005]

Nhờ các bạn tạo Sub giúp tôi, xem chi tiết trong file đính kèm

Bạn xem file đính kèm nhé.

 

[toandiennuoc123]

Cám ơn bạn, nhưng mình thấy không được tiện cho lắm, vì phải nhập thông số, nếu được như yêu cầu của mình thì hay quá

 

[mhung12005]

Cám ơn bạn, nhưng mình thấy không được tiện cho lắm, vì phải nhập thông số, nếu được như yêu cầu của mình thì hay quá

Nhập thông số vậy mới dễ tùy biến chứ bạn.

Bạn có thể chọn bất cứ vùng nào bạn muốn cũng như vị trí muốn đặt kết quả chỉ cần vài click chuột là xong.

Nếu bạn muốn chỉ như trong sheet của bạn thì càng dễ làm mà. Mình sẽ sửa giúp bạn

 

[toandiennuoc123]

Bạn cho mình hỏi : bây giờ copy ô bên trái thì sửa code thế nào ?

 

[mhung12005]

Bạn cho mình hỏi : bây giờ copy ô bên trái thì sửa code thế nào ?

Nếu muốn xác định thêm hướng copy nữa thì tôt nhất chuyển thành hàm cho dễ tùy biến.

Lựa chọn 1 trong 4 hướng copy luôn. Phải, trái, trên dưới

 

[mhung12005]

Bạn cho mình hỏi : bây giờ copy ô bên trái thì sửa code thế nào ?

Bạn dùng tạm hàm này xem sao:

Public Function MyCopy(ByVal rSrcRng As Range, Optional Opt As Long)   
   Dim TmpArr(), ResArr()
   Dim lR As Long, lC As Long, i As Long, k As Long
   
   ReDim TmpArr(1 To rSrcRng.Rows.Count * rSrcRng.Columns.Count, 1 To 1)
   For lR = 1 To rSrcRng.Rows.Count
      For lC = 1 To rSrcRng.Columns.Count
         If rSrcRng(lR, lC).Interior.Color <> 16777215 Then
            If Opt <> 0 Then
               Select Case Opt
               Case 1
                  If rSrcRng(lR, lC - 1) <> "" Then
                     k = k + 1
                     TmpArr(k, 1) = rSrcRng(lR, lC - 1)
                  End If
               Case 2
                  If rSrcRng(lR - 1, lC) <> "" Then
                     k = k + 1
                     TmpArr(k, 1) = rSrcRng(lR - 1, lC)
                  End If
               Case 3
                  If rSrcRng(lR + 1, lC) <> "" Then
                     k = k + 1
                     TmpArr(k, 1) = rSrcRng(lR + 1, lC)
                  End If
               End Select
            Else
               If rSrcRng(lR, lC + 1) <> "" Then
                  k = k + 1
                  TmpArr(k, 1) = rSrcRng(lR, lC + 1)
               End If
            End If
         End If
      Next lC
   Next lR
   If k Then
      ReDim ResArr(1 To k, 1 To 1)
      For i = 1 To k
         ResArr(i, 1) = TmpArr(i, 1)
      Next i
   End If
   MyCopy = ResArr
   
End Function

 

[toandiennuoc123]

Cám ơn bạn rất nhiều !!!!!!!!!. Đúng là " được voi đòi Hai Bà Trưng", bạn có thể kết hợp kiểu bài #3 và #4 được không ??? Khi muốn chọn kiểu copy thì xuất hiện thông báo chọn ( trên, dưới, trái, phải ) -> OK. Được như vậy thì hay quá... quá.

 

[mhung12005]

Cám ơn bạn rất nhiều !!!!!!!!!. Đúng là " được voi đòi Hai Bà Trưng", bạn có thể kết hợp kiểu bài #3 và #4 được không ??? Khi muốn chọn kiểu copy thì xuất hiện thông báo chọn ( trên, dưới, trái, phải ) -> OK. Được như vậy thì hay quá... quá.

Ái chà, không kết hợp kiểu đó đc đâu bạn ạ. Vì máy nó làm sao mà biết bạn đang nghĩ gì, muốn thế nào.

Mà theo mình thì bạn nên dùng code ở bài 3 sẽ tiện hơn. Mình chẳng thấy có khó khăn gì cả.

Thế này nhé, bạn chỉ cần nhấn cái nút Commanbutton1 --> xuất hiện hộp thoại --> dùng chuột chọn vùng bất kỳ mà bạn muốn --> nhấn ok --> dùng chuột chọn chỗ muốn đặt kết quả --> nhấn ok --> xong. Mình nghĩ quá đơn giản mà không tốn của bạn quá 30s. Mà thích cái là vùng chọn và vùng đặt kết quả là tùy ý.

Nếu có cải tiến thêm thì chỉ nên thêm phần hướng copy: phải, trái, trên, dưới là ok.

 

[toandiennuoc123]

Nếu có cải tiến thêm thì chỉ nên thêm phần hướng copy: phải, trái, trên, dưới là ok.

Đúng là cải tiến này đấy, mong bạn giúp cho

 

[mhung12005]

Đúng là cải tiến này đấy, mong bạn giúp cho

Hôm nay mới có thời gian rảnh cải tiến giúp bạn thêm cái này. Bạn xem file đính kèm nhé.

 

[Quang_Hải]

Nhờ các bạn tạo Sub giúp tôi, xem chi tiết trong file đính kèm

Thử file này coi sao. Quét chọn vùng cần xử lý. Click chuột phải, chọn vào Copy Menu, chọn tiếp trái, phải, trên, dưới...

 

[toandiennuoc123]

Cám ơn 2 bạn rất nhiều,cách của 2 bạn thật hay nhưng vẫn phải thay đổi chút xíu nữa thì mới tiện dùng.
1. vùng chọn và vùng gán dữ liệu là cố định
2. khi nhấn nút copy thì xuất hiện thông báo chọn xổ xuống :" trên, dưới, trái, phải" kích chọn kiểu rồi OK.
Cách sử dụng càng đơn giản càng tốt. Cám ơn 2 bạn đã nhiệt tình giúp đỡ