macro thực hiện thay cho lệnh cut (ctrl +x) (1 người xem)

vitinhvnbmt · 3/2/17

công việc của mình thường xuyên phải copy(cut) một đoạn text từ một ô ở file excel rồi paste vào một cửa sổ của phần mềm khác,
mà cứ dùng lệnh ctrl + x như vậy thì cũng thấy rất lâu vì lượng text phải copy sang lên tới hàng nghìn lần.
vậy có cách nào(macro) để mỗi khi mình đặt con trỏ vào 1 ô có dữ liệu ở cột B (như file đính kèm)thì macro đó sẽ cắt (cut) dữ liệu ở ô đó không?
(macro này nó sẽ làm công việc tương đương với việc mình chọn ô đó rồi nhấn ctrl + x)

mong được ace trong diễn đàn giúp đỡ.

nhân dịp đầu năm mới, xin kính chúc toàn thể ace trong diễn đàn GPE mạnh khỏe, thành công, an khang thịnh vượng :-=

phulien1902 · 3/2/17

vitinhvnbmt đã viết:
công việc của mình thường xuyên phải copy(cut) một đoạn text từ một ô ở file excel rồi paste vào một cửa sổ của phần mềm khác,
mà cứ dùng lệnh ctrl + x như vậy thì cũng thấy rất lâu vì lượng text phải copy sang lên tới hàng nghìn lần.
vậy có cách nào(macro) để mỗi khi mình đặt con trỏ vào 1 ô có dữ liệu ở cột B (như file đính kèm)thì macro đó sẽ cắt (cut) dữ liệu ở ô đó không?
(macro này nó sẽ làm công việc tương đương với việc mình chọn ô đó rồi nhấn ctrl + x)

mong được ace trong diễn đàn giúp đỡ.

nhân dịp đầu năm mới, xin kính chúc toàn thể ace trong diễn đàn GPE mạnh khỏe, thành công, an khang thịnh vượng

Bạn thử với:

PHP:

Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, Range("B:B")) Is Nothing Then
    Else
       ' ActiveCell.Cut
        Target.Cut
    End If
End Sub

Nguyễn Hồng Quang · 3/2/17

Bạn tạo 1 button rồi copy đoạn code này gán cho button đó
Thay vì ấn Ctrl+X thì bạn click vào button 1

Mã:

Sub Button1_Click()

    Selection.Cut


End Sub

vitinhvnbmt · 3/2/17

phulien1902 đã viết:
Bạn thử với:

PHP:

Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Intersect(Target, Range("B:B")) Is Nothing Then Else ' ActiveCell.Cut Target.Cut End If End Sub

bạn nói cụ thể hơn được không? mình làm không được

vitinhvnbmt · 3/2/17

Nguyễn Hồng Quang đã viết:
Bạn tạo 1 button rồi copy đoạn code này gán cho button đó
Thay vì ấn Ctrl+X thì bạn click vào button 1

Mã:

Sub Button1_Click() Selection.Cut End Sub

cũng là một cách hay, nhưng vẫn phải thêm thao tác bạn à --=0

Nguyễn Hồng Quang · 3/2/17

Nếu phải mở bảng mới thì bạn chỉ cần copy paste cái button ấy sang bảng mới là xong mà :-=

Nhưng theo mình cách nhanh nhất là bạn mở database của phần mềm ấy rồi update dữ liệu vào luôn

phulien1902 · 3/2/17

vitinhvnbmt đã viết:
bạn nói cụ thể hơn được không? mình làm không được

+Bạn chép Code trên vào Sheet3.
+Tại Cell bạn muốn Copy, bạn Click đúp.
+Đặt con trỏ tới nơi muốn đến, nhấn Ctrl +V.

vitinhvnbmt · 3/2/17

phulien1902 đã viết:
+Bạn chép Code trên vào Sheet3.
+Tại Cell bạn muốn Copy, bạn Click đúp.
+Đặt con trỏ tới nơi muốn đến, nhấn Ctrl +V.

không được bạn à. kích đúp xong nó cũng không cut cho mình nữa, không paste được

phulien1902 · 3/2/17

vitinhvnbmt đã viết:
không được bạn à. kích đúp xong nó cũng không cut cho mình nữa, không paste được

Vậy thì bạn thử bàng sự kiện sau:

PHP:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("B:B")) Is Nothing Then
    Else  
      ActiveCell.Cut  
     'Target.Cut  
  End If
End Sub

Sau đó bạn Click vào Cell cần Copy, đưa con trỏ chuột tới nơi cần Copy đến và nhấn Crtl +V.

vitinhvnbmt · 3/2/17

phulien1902 đã viết:
Vậy thì bạn thử bàng sự kiện sau:

PHP:

Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Intersect(Target, Range("B:B")) Is Nothing Then Else ActiveCell.Cut 'Target.Cut End If End Sub

Sau đó bạn Click vào Cell cần Copy, đưa con trỏ chuột tới nơi cần Copy đến và nhấn Crtl +V.

có cách nào để nó cut luôn không bạn? với đoạn mã trên thì nó mới chỉ copy thôi &&&%$R

phulien1902 · 3/2/17

vitinhvnbmt đã viết:
có cách nào để nó cut luôn không bạn? với đoạn mã trên thì nó mới chỉ copy thôi

Bạn thử làm như sau xem, bạn Copy Code dưới đây vào Module

PHP:

Sub XoaCell()
 Application.CutCopyMode = False 
  DK = MsgBox("question?", vbYesNo + vbQuestion, "Xoa") 
    If DK = vbYes Then   
 ActiveCell.ClearContents   
 End If
End Sub

Bạn gán Code này vào nút bấm.

Nguyễn Hồng Quang · 4/2/17

phulien1902 đã viết:
Vậy thì bạn thử bàng sự kiện sau:

PHP:

Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Intersect(Target, Range("B:B")) Is Nothing Then Else ActiveCell.Cut 'Target.Cut End If End Sub

Sau đó bạn Click vào Cell cần Copy, đưa con trỏ chuột tới nơi cần Copy đến và nhấn Crtl +V.

Tiếp nối đoạn code của bạn
Vậy Mình xin được bổ sung đoạn code nho nhỏ màu đỏ để khi ai đó muốn thay vì ấn ctrl+V mà chỉ cần click 1 chuột vào 1 ô khác ngoài vùng B:B là nó paste luôn
--------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("B:B")) Is Nothing Then
Else
ActiveCell.Cut
'Target.Cut
End If
If Intersect(Target, Range("C:AX")) Is Nothing Then
Else
ActiveSheet.Paste
End if
End Sub
------------------------------------
Vẫn là dạng code trên, nhưng cải tiến thêm hiện hộp thoại lựa chọn Yes hoặc No-> Paste dữ liệu ra vùng mong muốn

Mã:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("B:B")) Is Nothing Then
    Else
      ActiveCell.Cut


 End If
 If Intersect(Target, Range("C:AX")) Is Nothing Then
    Else
       ActiveSheet.Paste
End If


If Intersect(Target, Range("B:AX")) Is Nothing Then
    DK = MsgBox("Do you want paste here?", vbYesNo + vbQuestion, "Choice Box")
    If DK = vbYes Then
    
 ActiveSheet.Paste
 Else
 ActiveCell.ClearContents
End If
End If
End Sub

vitinhvnbmt · 4/2/17

phulien1902 đã viết:
Bạn thử làm như sau xem, bạn Copy Code dưới đây vào Module

PHP:

Sub XoaCell() Application.CutCopyMode = False DK = MsgBox("question?", vbYesNo + vbQuestion, "Xoa") If DK = vbYes Then ActiveCell.ClearContents End If End Sub

Bạn gán Code này vào nút bấm.

vậy thì rắc rối nhỉ. lại phải thêm một công đoạn nữa là nhấn nút xóa data của ô sau khi đã copy.

vitinhvnbmt · 4/2/17

Nguyễn Hồng Quang đã viết:
Tiếp nối đoạn code của bạn
Vậy Mình xin được bổ sung đoạn code nho nhỏ màu đỏ để khi ai đó muốn thay vì ấn ctrl+V mà chỉ cần click 1 chuột vào 1 ô khác ngoài vùng B:B là nó paste luôn
--------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("B:B")) Is Nothing Then
Else
ActiveCell.Cut
'Target.Cut
End If
If Intersect(Target, Range("C:AX")) Is Nothing Then
Else
ActiveSheet.Paste
End if
End Sub
------------------------------------
Vẫn là dạng code trên, nhưng cải tiến thêm hiện hộp thoại lựa chọn Yes hoặc No-> Paste dữ liệu ra vùng mong muốn

Mã:

Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Intersect(Target, Range("B:B")) Is Nothing Then Else ActiveCell.Cut End If If Intersect(Target, Range("C:AX")) Is Nothing Then Else ActiveSheet.Paste End If If Intersect(Target, Range("B:AX")) Is Nothing Then DK = MsgBox("Do you want paste here?", vbYesNo + vbQuestion, "Choice Box") If DK = vbYes Then ActiveSheet.Paste Else ActiveCell.ClearContents End If End If End Sub

ý tưởng của bạn rất hay nhưng mình không cut từ excel rồi paste vào excel mà là paste sang cửa sổ phần mềm khác.
nên mình muốn cut luôn data ở file excel cho nó đỡ bị nhầm lẫn. nhưng mà vẫn chưa có cách nào cut luôn cả.

Nguyễn Hồng Quang · 4/2/17

Vậy Mình "cut" không kịp chớp mắt luôn
bạn xem thử nhé

Mã:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("B:B")) Is Nothing Then
    Else
      ActiveCell.Cut
      ActiveCell.Font.ThemeColor = xlThemeColorDark1
  End If
End Sub

Hoặc bạn dùng code này (có thể là đúng với ý bạn hơn, nhưng mình thích code trên hơn)
Lưu ý Bạn:nếu dùng code này bạn phải thao tác Paste sang phần mềm kia trong vòng 4 giây thôi nhé, quá 4 giây là cười đấy nhé --=0

!!! ActiveCell.ClearContents !!!!!
Thực ra khi mình test code này thì thấy 4 giây là đủ

Mã:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("B:B")) Is Nothing Then
    Else
      ActiveCell.Cut
      ActiveCell.Font.ThemeColor = xlThemeColorDark1
    Application.Wait (Now + TimeValue("0:00:04"))
    ActiveCell.ClearContents
  End If
End Sub

Nếu cảm thấy không thao tác kịp trong vòng 4 nốt nhạc thì sửa cái TimeValue kia thành số thời gian bạn cảm thấy đủ
Nếu sau khi đã chỉnh tăng Timevalue , trong khi làm việc với bảng tính mà ko muốn chờ đợi thì thì ấn phím ESC để code chạy tiếp

vitinhvnbmt · 5/2/17

cái này của bạn rất hay, mình cũng thích dùng cái này hơn

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("B:B")) Is Nothing Then
Else
ActiveCell.Cut
ActiveCell.Font.ThemeColor = xlThemeColorDark1
End If
End Sub

phải nói là bạn làm ảo thuật rất hay, cắt nhưng thực chất không phải là cắt @$@!^%

Nguyễn Hồng Quang · 5/2/17

Hề hề Cái này là mình lấy ý tưởng từ 1 bài viết về dấu số 0 bằng Condition Format (chọn màu trắng khi các ô đạt điều kiện = 0 ) |||||

macro thực hiện thay cho lệnh cut (ctrl +x) (1 người xem)

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

Thành viên hoạt động

File đính kèm

GPE - My love

Thành viên GPE Hà Nội

Thành viên hoạt động

Thành viên hoạt động

Thành viên GPE Hà Nội

GPE - My love

Thành viên hoạt động

GPE - My love

Thành viên hoạt động

GPE - My love

Thành viên GPE Hà Nội

Thành viên hoạt động

Thành viên hoạt động

Thành viên GPE Hà Nội

Thành viên hoạt động

Thành viên GPE Hà Nội

Thời gian đếm ngược.