验证列只应存在数值

时间:2017-10-16 12:24:14

标签: vba excel-vba excel

我写了一段代码

  Sub CellCheck()
  Dim Header(1 To 2) As String
   Header(1) = "Header1" 'header name
   Header(2) = "Header2"  'header name
   Dim rCell As Range
   Dim sMyString As String
   On Error GoTo ErrorHandle
   Set rCell = Range("A:A)
   If IsNumeric(rCell.Value) = False And _
   IsError(rCell.Value) = False Then
   'assuming Error_sheet already present 
   Sheets("error_sheet").Range("A" & row).Value = "There are " & 
   Application.WorksheetFunction.IsNumeric(r) & " Rows with error in column" & 

   Header(i)
   On Error GoTo ErrorHandle
   Set rCell = Range("B:B)
   If IsNumeric(rCell.Value) = False And _
   IsError(rCell.Value) = False Then
   Sheets("error_sheet").Range("A" & row).Value = "There are " & 
   Application.WorksheetFunction.IsNumeric(r) & " Rows with error in column" & 
   Header(i)
  End sub

要验证两个列只能包含数值,如果任何列包含Text,Special character等,则单元格no。该列的列应出现在名为Error_sheet的不同表中。两列中的空白都很好。此外,列#Header1'的所有非空白单元格应具有相同的值,即如果A1 = 46,则列的所有单元格#Header1'应该只有46。如果没有宏应该出现在Error_sheet中,单元格号为no。并且应该在列#Header2'中执行相同的检查。以及

1 个答案:

答案 0 :(得分:0)

这应该有效。您的原始代码存在一些问题,因此请参阅下面的答案,了解一些有问题的方面。

Sub CellCheck()
Dim wsA As Worksheet, wsE As Worksheet
Dim rng As Range
Dim ct1 As Long, ct2 As Long, m1 As Long, m2 As Long, lastRow As Long
Dim str1 As String, str2 As String

Set wsA = ActiveSheet
Set wsE = Worksheets("error_sheet")

lastRow = WorksheetFunction.Max( _
    wsA.Cells(wsA.Rows.Count, 1).End(xlUp).Row, _
    wsA.Cells(wsA.Rows.Count, 2).End(xlUp).Row)
Set rng = wsA.Range(wsA.Cells(2, 1), wsA.Cells(lastRow, 2))

m1 = wsA.Cells(2, 1).Value
m2 = wsA.Cells(2, 2).Value

For Each cell In rng
    'skip first row
    If cell.Row <> 1 Then
        If cell.Column = 1 Then
            If Not IsNumeric(cell.Value) Then ct1 = ct1 + 1
            If cell.Value <> m1 and cell.Value <> "" Then str1 = _
                CombStr(str1, Replace(cell.Address, "$", ""))
        ElseIf cell.Column = 2 Then
            If Not IsNumeric(cell.Value) Then ct2 = ct2 + 1
            If cell.Value <> m2 and cell.Value <> "" Then str2 = _
                CombStr(str2, Replace(cell.Address, "$", ""))
        End If
    End If
Next cell

wsE.Range("A" & 1) = _
"There are " & ct1 & " rows with errors in column " & wsA.Cells(1, 1)
wsE.Range("A" & 2) = _
"There are " & ct2 & " rows with errors in column " & wsA.Cells(1, 2)
If str1 <> "" Then wsE.Range("A" & 3) = _
"The following cells in column A did not match the value in cell A2: " & str1
If str2 <> "" Then wsE.Range("A" & 4) = _
"The following cells in column B did not match the value in cell B2: " & str2

'put any additional code you need here

End Sub

Function CombStr(str1 As String, str2 As String) As String
If str1 = "" And str2 <> "" Then
    CombStr = str2
ElseIf str1 <> "" And str2 = "" Then
    CombStr = str1
ElseIf str1 <> "" And str2 <> "" Then
    CombStr = str1 & ", " & str2
End If
End Function
  • IsNumeric不能使用范围,只能使用单个值,因此您需要循环浏览范围中的值并单独检查它们
  • Range("A:A)Range("B:B)无法正确评估(缺少"
  • rowr永远不会在任何地方定义或分配值
  • 永远不会定义ErrorHandle部分
  • 关于Application.WorksheetFunction.IsNumeric(r)IsNumeric不是工作表函数(=ISNUMBER()是),所以它前面不需要Application.WorksheetFunction.,这个表达式只会返回一个TrueFalse,而不是我认为你想要的实际数字
  • End If
  • 没有If
  • sMyString似乎没有被使用