Nhờ hỗ trợ chọn vùng trong Inputbox ở VBA

[Phuongmai2015]

Các bác chỉ giúp em với ạ
Em đang làm 1 chương trình nhỏ như thế này bằng VBA
1. Khi nhấn nút "Đồng ý" sẽ xuất hiện inputBox
2. Người sử dụng chọn vùng/ ô
3. Khu vực được lựa chọn sẽ điền chữ "ĐỒNG Ý + ngày"
vấn đề cần trợ giúp:
Có cách nào để chỉ được chọn trong 1 vùng hoặc ô thỏa mãn điều kiện là: Chỉ được chọn trong cột H và ô tương ứng ở cột B phải có dữ liệu (ô ở cột B không đc bỏ trống)
VD: muốn chọn ô H5 thì ô B5 phải có dữ liệu, ko dc để trống
Ô B5 đang trống thì ko chọn đc H5
Cảm ơn ạ

 

[bebo021999]

File của bạn khi mở lên thì rơi vào trạng thái chờ (đồng hồ cát). Bạn có macro nào trong Workbook_Open không?
Bạn có thể copy code và paste ở đây để kiểm tra thử có gì lạ không?

 

[Phuongmai2015]

File của bạn khi mở lên thì rơi vào trạng thái chờ (đồng hồ cát). Bạn có macro nào trong Workbook_Open không?
Bạn có thể copy code và paste ở đây để kiểm tra thử có gì lạ không?

Xin lỗi em gửi file lại (bỏ công thức link với file khác đi ạ)
Dưới đây là đoạn code em viết cho nút "ĐỒNG Ý"

Sub Rectangle1_Click()
ActiveSheet.Unprotect Password:="PM123"
Dim OK As Range
On Error Resume Next
Set OK = Application.InputBox("please select a range:", "Vui long chon vung duyet", "ô/vùng phê duyêt", Type:=8)
If OK Is Nothing Then Exit Sub
OK = "DONG Y" & " / " & Environ("COMPUTERNAME") & " (" & Date & " " & Time & ")"
MsgBox "Thuc hien thanh cong"
ActiveSheet.Range("H" & a).ClearContents
OK.Interior.Color = vbGreen
ActiveSheet.Protect Password:="PM123"
End Sub

 

[SA_DQ]

Tham khảo cái ni xem có giúp ích gì cho bạn chủ bài đăng không?

Sub Button1_Click()
    ActiveSheet.Unprotect Password:="PM123"
    Dim xRg As Range, Cls As Range
    
    Set xRg = Application.InputBox("please select a range:", "Vui long chon vung can kiem tra", _
        Application.ActiveSheet.UsedRange.Address, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    'Kiêm Tra Vùng xRg:     '
    If Not Intersect(xRg, Columns("H:H")) Is Nothing Then
        If xRg.Cells.Count = 1 And Cells(xRg.Row, "B").Value <> "" Then
            xRg.Interior.Color = vbCyan
            ActiveSheet.Protect Password:="PM123"
            Exit Sub
        ElseIf xRg.ce4lls.Count > 1 Then
            For Each Cls In xRg
                If Cells(Cls.ros, "B").Value <> "" Then
                    '           '
                End If
            Next Cls
        End If
    End If
End Sub

 

[Phuongmai2015]

Tham khảo cái ni xem có giúp ích gì cho bạn chủ bài đăng không?

Sub Button1_Click()
    ActiveSheet.Unprotect Password:="PM123"
    Dim xRg As Range, Cls As Range
   
    Set xRg = Application.InputBox("please select a range:", "Vui long chon vung can kiem tra", _
        Application.ActiveSheet.UsedRange.Address, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    'Kiêm Tra Vùng xRg:     '
    If Not Intersect(xRg, Columns("H:H")) Is Nothing Then
        If xRg.Cells.Count = 1 And Cells(xRg.Row, "B").Value <> "" Then
            xRg.Interior.Color = vbCyan
            ActiveSheet.Protect Password:="PM123"
            Exit Sub
        ElseIf xRg.ce4lls.Count > 1 Then
            For Each Cls In xRg
                If Cells(Cls.ros, "B").Value <> "" Then
                    '           '
                End If
            Next Cls
        End If
    End If
End Sub

em chạy nó báo lỗi dòng lệnh này ạ

ElseIf xRg.ce4lls.Count > 1 Then

 

[SA_DQ]

À dòng lệnh đó mình sai chính tả (Dư con số 4 vô diên!); Bạn sửa lại giúp mình & cảm ơn bạn nhiều!

 

[Phuongmai2015]

À dòng lệnh đó mình sai chính tả (Dư con số 4 vô diên!); Bạn sửa lại giúp mình & cảm ơn bạn nhiều!

Dạ cảm ơn anh. Đúng mong muốn của em rùi ạ
Em hỏi thêm cái nữa ạ
Cũng ở cột H, thêm điều kiện là ô được chọn đã có dữ liệu thì cũng không chạy được
Ví dụ: ô H5 đã có dữ liệu thì không chọn được ô đó

 

[SA_DQ]

Chuyện chọn là chuyện của trời & đất; Ta không nên can thiệp;
Ta chỉ nên ra điều kiện là chưa có dữ liệu ở ô đó thì mới thực hiện các câu lệnh bên dưới:
Bạn thêm điều kiện vô 2 câu lệnh mà mình mới qúinh số ở #4, như:
If xRg.Cells.Count = 1 And Cells(xRg.Row, "B").Value <> "" Then
=> If xRg.Cells.Count = 1 And Cells(xRg.Row, "B").Value <> "" And Cells(xRg.Row, "H").Value = "" Then

 

[Phuongmai2015]

Chuyện chọn là chuyện của trời & đất; Ta không nên can thiệp;
Ta chỉ nên ra điều kiện là chưa có dữ liệu ở ô đó thì mới thực hiện các câu lệnh bên dưới:
Bạn thêm điều kiện vô 2 câu lệnh mà mình mới qúinh số ở #4, như:
If xRg.Cells.Count = 1 And Cells(xRg.Row, "B").Value <> "" Then
=> If xRg.Cells.Count = 1 And Cells(xRg.Row, "B").Value <> "" And Cells(xRg.Row, "H").Value = "" Then

Dạ đc rùi ạ. Cảm ơn anh nhiều nhiều

 

[Phuongmai2015]

Dạ đc rùi ạ. Cảm ơn anh nhiều nhiều

@SA_DQ ơi cái code anh viết hôm trước em copy vào nó chạy ngon nghẻ lắm rồi
thế mà hôm nay em mở ra xem lại, nó lại không ra kết quả gì luôn
Em gửi file (em bỏ hết công thức, file nhẹ lắm rồi) nhờ anh xem giúp em với ạ
cảm ơn anh

 

[bebo021999]

@SA_DQ ơi cái code anh viết hôm trước em copy vào nó chạy ngon nghẻ lắm rồi
thế mà hôm nay em mở ra xem lại, nó lại không ra kết quả gì luôn
Em gửi file (em bỏ hết công thức, file nhẹ lắm rồi) nhờ anh xem giúp em với ạ
cảm ơn anh

Anh Sa vô lại quính tiếp đi kìa anh, đang ngon nghẻ zị mà...

 

[Phuongmai2015]

Anh Sa vô lại quính tiếp đi kìa anh, đang ngon nghẻ zị mà...

À, em tìm ra nguyên nhân rồi, ban nãy máu chưa lên não. Cảm ơn mọi ng ạ

 

[forcebk]

mình cần dùng inputbox chọn nhiều vùng trong các sheet khác nhau để copy mà loay mãi vẫn chưa được, mong được các bác chỉ cho con đường sáng

 

[Hoàng Tuấn 868]

mong được các bác chỉ cho con đường sáng

Cứ đường nào ban đêm có đèn bật lên đều là con đường sáng hết bạn ơi.