Nhờ viết code add InputMessage vào các ô theo điều kiện. (1 người xem)

[TrungChinhs]

Chào các bạn! Tôi muốn viết code để add InputMessage vào các ô theo điều kiện. Yêu cầu và ví dụ cụ thể trong file đính kèm.
Nhờ các các bạn viết giúp. Thanks!

 

[huuthang_bd]

Chào các bạn! Tôi muốn viết code để add InputMessage vào các ô theo điều kiện. Yêu cầu và ví dụ cụ thể trong file đính kèm.
Nhờ các các bạn viết giúp. Thanks!

Viết trên Excel 2007, không biết có tương thích với Excel 2003 không.

Sub GPE()
For Each cll In Range([B4], [B65536].End(xlUp))
    If InStr(cll.Value, "PABT") > 0 Then
    For i = 1 To 9
    With cll.Offset(, i).Validation
        .Delete
        .add Type:=xlValidateInputOnly
        .InputMessage = Sheets("Sheet1").[C3].Offset(i).Value
    End With
    Next
    ElseIf InStr(cll.Value, "PA") > 0 Then
    For j = 1 To 9
    With cll.Offset(, j).Validation
        .Delete
        .add Type:=xlValidateInputOnly
        .InputMessage = Sheets("Sheet1").[C15].Offset(j).Value
    End With
    Next
    End If
Next
End Sub

 

[ndu96081631]

Chào các bạn! Tôi muốn viết code để add InputMessage vào các ô theo điều kiện. Yêu cầu và ví dụ cụ thể trong file đính kèm.
Nhờ các các bạn viết giúp. Thanks!

Em làm tạm như vầy:

Sub Add_InputMsg()
  Dim Clls As Range, FRng As Range, i As Long
  With Range(Sheet2.[B4], Sheet2.[B65536].End(xlUp))
    For Each Clls In .SpecialCells(2)
      i = 0
      If InStr(Clls, Sheet1.[C3]) Then
        Set FRng = Sheet1.[C3]
      ElseIf InStr(Clls, Sheet1.[C15]) Then
        Set FRng = Sheet1.[C15]
      End If
      If Not FRng Is Nothing Then
        Do
          i = i + 1
          With Clls.Offset(, i).Validation
            .Delete
            .add xlValidateInputOnly
            .InputMessage = FRng.Offset(i).Value
          End With
        Loop Until IsEmpty(FRng.Offset(i + 1))
      End If
    Next Clls
  End With
End Sub

Chưa hay lắm ---> Anh có thể chỉnh sửa lại