Dạ, em muốn show các thông tin cần thiết để tiết kiệm kích thước bảng, do khối lượng data lớn. Khi muốn ktra gì đó thì rê chuột để hiện lên. Excel ko làm đc việc này anh nhỉ? Ko yêu xin đừng nói lời cay đắng, haha
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rws As Long: Dim Rng As Range
Rws = [A99999].End(xlUp).Row
Set Rng = [A1].Resize(Rws)
If Not Intersect(Target, Rng) Is Nothing Then
MsgBox Target.Offset(, 1).Value, , "Xin Chào"
End If
End SubCám ơn bạn rất nhiều, để mình chạy thử. Ủa mà code này áp dụng cho đề bài của mình phải ko bạn? Thấy khác khác nhỉ
Trên bảng tính excel không có sự kiện Mouse Move, nhưng có thể ăn gian bằng cách chạy code nạp hết cột B vào comment thì khi ta đưa chuột đến ô nào đó của cột A thì comment sẽ tự hiện ra. Tuy nhiên thấy kỳ kỳ nên không muốn code
Dạ, e hiểu rồi. Cám ơn anh rất nhiều
Anh hướng dẫn em " chạy code nạp hết cột B vào comment" với ạ, e ghi cho 1 cell thì đc nhưng làm sao để nạp 1 lần comment cho cột A thì e ko rõ?
Thử code này. Thay thế tên sheet và vùng cần xử lý cho phù hợp cho phù hợp. Code này giả định dữ liệu bắt đầu từ A1
Sub Add_Comment()
Dim sArr(), i As Long
With Sheets("Sheet1")
sArr = .Range("A1", .Range("A" & Rows.Count).End(3)).Resize(, 2).Value
For i = 1 To UBound(sArr)
.Cells(i, 1).ClearComments
.Cells(i, 1).AddComment CStr(sArr(i, 2))
Next
End With
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sCmt$
Range(Cells(1, 1), Cells(10000, 1)).ClearComments
If Target.Row > 1 And Target.Column = 1 And Target.Count = 1 Then
sCmt = Cells(Target.Row, 2).Text
Target.AddComment
Target.Comment.Text sCmt
End If
End Sub/-)úng là không có gì bất tiện khi vận hành, nhưng tốn điện là cái chắc!
← → ← → ← → ← → ← → ← → ← Cám ơn bác, mà hình như bác chưa hiểu ý tui
Em cám ơn anh
Bạn có thể gợi ý cho tớ cái ứng dụng của việc này được không? Tự nhiên tớ thấy hay hay.
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> 1 Or Target.Count > 1 Then Exit Sub
With Target.Validation
.Delete
.Add Type:=xlValidateInputOnly
.InputMessage = Target.Offset(, 1).Value
End With
End SubEm cũng đang tò mò ý của tác giả. Em thích SelectionChange của 2 bác hơn là chạy Sub (bác Hải đừng buồn nhé).
Ôi giời, buồn vụ gì chứ? Quan trọng là con thỏ thì thích ăn củ cải còn con cá thì thích ăn con giun con dế. Nhu cầu thực tế của người dùng đa dạng lắm mọi người ạ.
Xóa thì đơn giản, nhưng phụ thuộc việc DataValidation nó có ảnh hưởng đến mức cần thiết phải xóa hay không thôi. Nói thêm là DataValidation này không khống chế việc nhập dữ liệu hay ràng buộc kiểu dữ liệu, mà chỉ đơn thuần phục vụ chi việc "show" text ra thôi.
Dạ, thực ra ko bắt buộc là MouseMove đâu anh, mục đích là đưa chuột qua cell Cột A thì hiện thị thông tin cell Cột B (bị ẩn) bên cạnh. Ý tưởng đưa vào Commnet của anh theo em là hợp lý, để e thử code anh gửi có gì cho anh hay.
Tiện thể tớ muốn hỏi ứng dụng vào việc gì thì chia sẻ nhé.
Nếu thế này thì Group hay hơn, nhìn được vài dòng liên tục.
Group cột hả bạn? mình đang Group đó, nhưng muốn xem lại phải mở ra, mà mình ko muốn tăng bề rộng của bảng
Cơ bản là với cái ảnh thì muốn biết % cái nào lớn hơn nữa thì phải di chuột đến từng ô cũng mất thời gian phết. Nhu cầu hơi khó hiểu.
Nó là loại hồ sơ mang tính chất đặc biệt bác ạ, dùng rất nhiều trí tuệ của anh em để tránh việc đá bôm bốp.
Function LiveComment(value, refCell As Range)
On Error Resume Next
With refCell
If Not .Comment Is Nothing Then .ClearComments
With .AddComment(CStr(value)).shape
With .TextFrame
.AutoSize = 1
.AutoSize = 0
End With
.Width = .Width + 20
End With
End With
LiveComment = value
End FunctionDo công việc mình hay sử dụng bằng điện thoại mở file nên muốn luôn để trạng thái ít cột nhất có thể, chứ nếu chỉ máy tính thì ko thành vấn đề
Xử lý theo kiểu tham chiếu A để lấy dòng & từ đó hiện thì nội dung B
Hàm này là đúng ý mình nhất. Cám ơn bạn rất nhiều nhiều
Khi mình đưa và Google Sheet thì nó báo lỗi này:
' _,
' ___ _ _ _ ___(_)
'/ __| / \ | \| | _ | |
'\__ \/ \ \| \\ | _ \ |
'|___/_/ \_|_|\_|___/_|
'
Option Explicit
#If VBA7 Then
#Else
Public Enum LongLong:[_]:End Enum
#If Win64 Then
#Else
Public Enum LongPtr:[_]:End Enum
#End If
#End If
Public Const PtrNull As LongPtr = 0
Private Type TypeArguments
Caller As Range
comment As String
cells As Variant
FontBold As Boolean
FontSize As Single
End Type
#If VBA7 Then
Private Declare PtrSafe Function SetTimer Lib "USER32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As LongPtr, ByVal lpTimerFunc As LongPtr) As Long
Private Declare PtrSafe Function KillTimer Lib "USER32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long
#Else
Private Declare Function SetTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
#End If
Private Works() As TypeArguments
Function LiveComment(value, ParamArray cells())
LiveComment = value
On Error Resume Next
Dim k%, rg: Set rg = Application.ThisCell
LiveComment = value
k = UBound(Works): k = k + 1: ReDim Preserve Works(1 To k)
With Works(k): Set .Caller = rg: .comment = value: .cells = cells: End With
Call SetTimer(0&, 0&, 0, AddressOf LiveComment_callback)
End Function
Private Sub LiveComment_callback(ByVal hWnd As LongPtr, ByVal wMsg As LongPtr, ByVal idEvent As LongPtr, ByVal dwTime As LongPtr)
On Error Resume Next
KillTimer 0&, idEvent
Dim lr&, UA%, i&, b As TypeArguments, cell
UA = UBound(Works)
For i = 1 To UA
b = Works(i)
For Each cell In b.cells
If TypeName(cell) = "Range" Then
cell.comment.Delete
cell.AddComment b.comment
With cell.comment
.Shape.TextFrame.AutoSize = 0
.Shape.TextFrame.AutoSize = 1
.Shape.Width = .Shape.Width + 10
End With
End If
Next
Next
Erase Works
On Error GoTo 0
End SubĐã thử đoạn code này trong GS mà vẫn không lưu đc, vậy chắc hết cách làm trong GS rồi,
