Tạo vba cộng thêm 1 vào 1 ô đã chọn khi nhấn nút

Liên hệ QC

huuman243

Thành viên mới
Tham gia
6/12/19
Bài viết
2
Được thích
0
Chào mọi người,
Hiện tại mình muốn viết một hàm VBA khi nhấn 1 nút thì ô đã được chọn sẽ tự cộng thêm 1 ,mà mình làm hoài ko được(VBA mình chỉ đang tìm hiểu)
Mong mọi người giúp đỡ
Cám ơn mọi người đã đọc
 
Chào mọi người,
Hiện tại mình muốn viết một hàm VBA khi nhấn 1 nút thì ô đã được chọn sẽ tự cộng thêm 1 ,mà mình làm hoài ko được(VBA mình chỉ đang tìm hiểu)
Mong mọi người giúp đỡ
Cám ơn mọi người đã đọc
Xài tạm cái này
Mã:
Public Sub Them1()
If IsNumeric(ActiveCell.Value) Then
    ActiveCell.Value = ActiveCell.Value + 1
Else
    MsgBox "Không phai là so, không cong duoc"
End If
End Sub
 
Mình chọn nhiều ô cùng lúc thì sửa code thế nào bạn?
Code cùi bắp:
Mã:
Public Sub Them1()
Dim cell As Range
For Each cell In Selection
If IsNumeric(cell) Then
    cell.Value = cell.Value + 1
Else
    MsgBox "Không phai là so, không cong duoc"
End If
Next cell
End Sub
 
Code cùi bắp:
Mã:
Public Sub Them1()
Dim cell As Range
For Each cell In Selection
If IsNumeric(cell) Then
    cell.Value = cell.Value + 1
Else
    MsgBox "Không phai là so, không cong duoc"
End If
Next cell
End Sub
Chọn một vùng có nhiều ô không phải số nhấp mỏi tay.
 
Chọn một vùng có nhiều ô không phải số nhấp mỏi tay.
Nhâp mỏi gối mới sợ chứ mỏi tay nhằm nhòi gì.

Chú tác giả bài #2: loại bài "sửa số" này thường đi đôi với một nút nhấp vào thì sửa ngược lại, thay cho Ctrl+Z, vì bị VBA ém mất.
 

huuman243

Bạn có thể tham khảo code dưới đây

Đặt thủ tục Add1ForValues vào nút
Sau khi click để cộng 1 thì bạn có thể click vào nút Undo để hoàn lại giá trị trước click


JavaScript:
Private BackupValues As Variant
Private BackupObject As Object

Sub Add1ForValues()
  If TypeName(Selection) <> "Range" Then
    Exit Sub
  End If
  If Selection.Address = Selection.Cells.Address Then
    Exit Sub
  End If
  If IsError(Selection.Value) Then
    Exit Sub  
  End If

  BackupValues = Selection.Value
  Dim s$
  Set BackupObject = Selection

  s = BackupObject.Address
  BackupObject.Value = Application.Evaluate("=if(ISNUMBER(" & s & "),1 +" & s & "," & s & ")")
  Application.OnUndo "UndoAdd1ForValues", "'" & ThisWorkbook.Name & "'!UndoAdd1ForValues"
End Sub

Sub UndoAdd1ForValues()
  On Error Resume Next
  If TypeName(BackupObject) <> "Range" Then
    Exit Sub
  End If
  BackupObject.Value = BackupValues
  If IsArray(BackupValues) Then
    Erase BackupValues
  End If
  Set BackupObject = Nothing
End Sub
 
2 mà diễn thành 4.
 
Web KT
Back
Top Bottom