返回列表 上一主題 發帖

[發問] worksheet_change 填滿問題

[發問] worksheet_change 填滿問題

我程式是在E欄到F欄的儲存格中輸入"0"顯示OK,輸入"1"為NG,但是如果我想要向下或向右拉填滿就會出錯,有人知道是哪裡出問題了嗎?
  1. Private Sub Worksheet_Change(ByVal Target As Excel.Range)

  2.     If Target.Column = 5 Then
  3.         ThisRow = Target.Row
  4.         If Target.Value = "0" Then
  5.             Range("E" & ThisRow).Value = "OK"
  6.         ElseIf Target.Value = "1" Then
  7.             Range("E" & ThisRow).Value = "NG"
  8.         Else
  9.         End If
  10.     End If
  11. '----------------------------------------------------
  12.     If Target.Column = 6 Then
  13.         ThisRow = Target.Row
  14.         If Target.Value = "0" Then
  15.             Range("F" & ThisRow).Value = "OK"
  16.         ElseIf Target.Value = "1" Then
  17.             Range("F" & ThisRow).Value = "NG"
  18.         Else
  19.         End If
  20.     End If
  21. '----------------------------------------------------
  22.     If Target.Column = 7 Then
  23.         ThisRow = Target.Row
  24.         If Target.Value = "0" Then
  25.             Range("G" & ThisRow).Value = "OK"
  26.         ElseIf Target.Value = "1" Then
  27.             Range("G" & ThisRow).Value = "NG"
  28.         Else
  29.         End If
  30.     End If
  31. '----------------------------------------------------
  32.     If Target.Column = 8 Then
  33.         ThisRow = Target.Row
  34.         If Target.Value = "0" Then
  35.             Range("H" & ThisRow).Value = "OK"
  36.         ElseIf Target.Value = "1" Then
  37.             Range("H" & ThisRow).Value = "NG"
  38.         Else
  39.         End If
  40.     End If
  41. '----------------------------------------------------
  42.     If Target.Column = 9 Then
  43.         ThisRow = Target.Row
  44.         If Target.Value = "0" Then
  45.             Range("I" & ThisRow).Value = "OK"
  46.         ElseIf Target.Value = "1" Then
  47.             Range("I" & ThisRow).Value = "NG"
  48.         Else
  49.         End If
  50.     End If
  51.    
  52. End Sub
複製代碼

製程檢查記錄表(路徑檔).rar (19.39 KB)

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim SelRng As Range
Set SelRng = Application.Intersect([E11:I36,E50:I74], Target)
If SelRng Is Nothing Then Exit Sub
If SelRng.Count > 1 Then Exit Sub
If SelRng & "" = "0" Then
   SelRng = "OK"
ElseIf SelRng & "" = "1" Then
   SelRng = "NG"
End If
End Sub


======================

TOP

回復 3# 准提部林
感謝版主解答~還幫忙簡化程式~謝謝

TOP

        靜思自在 : 太陽光大、父母恩大、君子量大,小人氣大。
返回列表 上一主題