使用VBA

时间:2018-10-03 09:50:11

标签: excel vba excel-vba

在Excel工作表中,第一行有一个标题,第二行有每列的标题。标题为“ A ”和“ B ”的列包含初始数据,标题为“ TF ”的列将包含结果数据(Excel A B C 列)。
在以下代码中,左侧1到5的数字只是行标题,而不是工作表中的数据

1  Table
2  A    B   TF
3  ABC  ABC TRUE
4  ABC  BAC FALSE
5  #N/A ABC #N/A

我尝试过的。

Sub Compare2Col()
Dim colAnum As Integer, colBnum As Integer, loopNum As Integer, i As Integer
    Dim holder As Variant
colAnum = Worksheets("Sheet1").Range("A1048576").End(xlUp).Row
colBnum = Worksheets("Sheet1").Range("B1048576").End(xlUp).Row
If colAnum > colBnum Then
    loopNum = colAnum
Else
    loopNum = colBnum
End If
For i = 3 To loopNum
If Range("A" & i).Value = "" Or Range("B" & i).Value = "" Or Range("A" & i).Value = "#N/A" Or Range("B" & i).Value = "#N/A" Then
        Range("C" & i).Value = "#N/A"
Else
    If Range("A" & i).Value = Range("B" & i).Value Then
        Range("C" & i).Value = True
    Else
        Range("C" & i).Value = False
    End If
End If
Next i

End Sub

这是我目前正在尝试使用的代码。在某些单元格中,我将具有这些“#N / A”值。我如何有一个if语句,以便当它为true时,将相同的“#N / A”值放入第三列。

我读到这些#N / A值是错误的。因此,在VBA中,我通过以下方式将#N / A值放入变量中:

holder = Range("A" & 5).Value

“ holder”变量的结果为“ 错误2042 ”。

先谢谢了。非常感谢您的帮助!

3 个答案:

答案 0 :(得分:0)

尝试使用IsEmptyIsError

    For i = 1 To loopNum
    If IsEmpty(Range("A" & i)) Or IsEmpty(Range("B" & i)) Or IsError(Range("A" & i)) Or IsError(Range("B" & i)) Then
            Range("C" & i).Value = "#N/A"
    Else
        If Range("A" & i).Value = Range("B" & i).Value Then
            Range("C" & i).Value = True
        Else
            Range("C" & i).Value = False
        End If
    End If
    Next i

答案 1 :(得分:0)

成功处理臭名昭著的VBA错误(2042)!?

在使用此代码之前,请确保您至少仔细研究了定制部分,否则可能会丢失数据。
最重要的是,第二列必须始终与第一列的右侧相邻,否则无法使用“数组复制粘贴版本”完成此代码。
@Melbee:我假设您的初始数据在A列中 ciFirstCol  和B iSecondCol = ciFirstCol + 1,结果应在C cCOff 'if 1 then first column next to the second column列中。如果没有,请在“定制”部分中进行更改。

Option Explicit
'-------------------------------------------------------------------------------
Sub XthColumnResult()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Description
  'In an Excel worksheet uses two adjacent columns of initial data as arguments
  'for a function whose result is pasted into a third column anywhere to the
  'right of the two initial columns.
  '(In short: 2 cols of data, perform calculation, result in third column)
'Arguments as constants
  'cWbName
    'The path of the workbook, if "" then ActiveWorkbook
  'cWsName
    'Name of the worksheet, if "" then ActiveSheet
  'cloFirstRow
    'First row of data
  'ciFirstCol
    'First column of data
  'cCOff
    'Column offset, where to paste the results into.
'Returns
  'The resulting data in a new column to the right of the two initial adjacent
  'columns of data.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'-- CUSTOMIZE BEGIN --------------------
  Const cWbName As String = "" 'Workbook Path (e.g. "C:\MyExcelVBA\Data.xls")
  Const cWsName As String = "" 'Worksheet Name (e.g. "Sheet1", "Data",... etc.
  Const cloFirstRow As Long = 3 'First Row of Data

  'Const cloLastRow as Long = Unknown >therefore> Dim loRow as Long

  Const ciFirstCol As Integer = 1 'First Column of Data (1 for A, 2 for B etc.

  'Second column of data must be adjacent to the right of first column.
  'See iSecondCol. Therefore Dim iSecondCol As Integer

  'Column offset where to paste the results into. Default is 1 i.e. the first
  'column next to the second column.
  Const cCOff As Integer = 1
'-- CUSTOMIZE END ----------------------

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Variables
  Const cStrVBAError As String = "Error 20" 'Debug VBA Error Variable
  Const cStrVBAErrorMessage As String = "Not Possible." 'Debug VBA Error Message
  Dim oWb As Workbook
  Dim oWs As Worksheet
  Dim oRng As Range
  Dim TheArray() As Variant
  Dim SmallArray() As Variant
  Dim loRow As Long 'Last Row of Data
  Dim iSecondCol As Integer 'Second Column of Data
  Dim iF1 As Integer 'Column Counter
  Dim loArr As Long 'Array Row Counter
  Dim iArr As Integer 'Array Column Counter
  Dim str1 As String 'Debug String
  Dim str2 As String 'Debug Helper String
  Dim varArr As Variant 'Helper Variable for the Array

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Determine workbook and worksheet
  If cWbName = "" Then
    Set oWb = ActiveWorkbook
   Else
    Set oWb = Workbooks(cWbName)
  End If
  If cWsName = "" Then
    Set oWs = oWb.ActiveSheet
   Else
    Set oWs = oWb.Worksheets(cWsName)
  End If

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Calculate second column of data
  iSecondCol = ciFirstCol + 1
  'Calculate last row of data (the greatest row of all columns)
  loRow = 0
  'Trying to translate the code to English:
  'For each column go to the last cell and press crtl+up which is the last
  'cell used in that column and use the row property...
  For iF1 = ciFirstCol To iSecondCol
    '...and check if it is greater than loRow.
    If loRow < oWs.Cells(Rows.Count, ciFirstCol + iF1 - 1).End(xlUp).Row Then
      'Assign the row to loRow (if it is greater than loRow).
      loRow = oWs.Cells(Rows.Count, ciFirstCol + iF1 - 1).End(xlUp).Row
    End If
  Next

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Status
    'The last row of data has been calculated. Additionally the first row, the
    'first column and the second column will be the arguments of the following
    'range (to be assigned to an array).
  'Remarks
    'When performing calculation, objects like workbooks, worksheets, ranges are
    'usually very slow. To speed up, an array is introduced to hold the data
    'and to calculate from there which is dozens of times faster.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Assign the range of data to an array.
  TheArray = oWs.Range(Cells(cloFirstRow, ciFirstCol), Cells(loRow, iSecondCol))

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Status
    'All data is now in TheArray ready for calculation.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'  str1 = "Initial Contents in TheArray"
'  For loArr = LBound(TheArray, 1) To UBound(TheArray, 1)
'    For iArr = LBound(TheArray, 2) To UBound(TheArray, 2)
'      If iArr > 1 Then
'        str1 = str1 & Chr(9) 'Next Column
'       Else 'First run-though.
'        str1 = str1 & vbCrLf 'Next Row
'      End If
'      If Not IsError(TheArray(loArr, iArr)) Then
'        str1 = str1 & TheArray(loArr, iArr)
'       Else
'        str1 = str1 & VbaErrorString(TheArray(loArr, iArr))
'      End If
'    Next
'  Next
'  Debug.Print str1
'  str1 = ""

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Remarks
    'A one-based array is needed to be pasted into the worksheet via range.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Create a new array for the resulting column.
  ReDim SmallArray(LBound(TheArray) To UBound(TheArray), 1 To 1)

  'Calculate values of the resulting column.
  For loArr = LBound(TheArray, 1) To UBound(TheArray, 1)
    'Read values from TheArray and calculate.
    If IsError(TheArray(loArr, 1)) Then 'First column error
      'VBA Error Handling, the result if both columns contain an error.
      varArr = VbaErrorString(TheArray(loArr, 1))
     Else
      If IsError(TheArray(loArr, 2)) Then 'Second column error
        'VBA Error Handling
        varArr = VbaErrorString(TheArray(loArr, 2))
       Else
        If TheArray(loArr, 1) = "" Or TheArray(loArr, 2) = "" Then '""
           varArr = "#N/A"
         Else
          Select Case TheArray(loArr, 1) 'Equal
            Case TheArray(loArr, 2)
              varArr = True
            Case Is <> TheArray(loArr, 2) 'Not equal
              varArr = False
            Case Else
              varArr = "UNKNOWN ERROR" 'Should never happen.
          End Select
        End If
      End If
    End If
    'Write the results to SmallArray.
    SmallArray(loArr, 1) = varArr
  Next

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Status
    'The resulting column containing the results has been written to SmallArray.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'  str1 = "Resulting Contents in SmallArray"
'  For loArr = LBound(SmallArray, 1) To UBound(SmallArray, 1)
'    If Not IsError(SmallArray(loArr, 1)) Then
'      str1 = str1 & vbCrLf & SmallArray(loArr, 1)
'     Else
'      'VBA Error Handling
'      str1 = str1 & vbCrLf & VbaErrorString(SmallArray(loArr, 1))
'    End If
'  Next
'  Debug.Print str1

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Calculate the range where to paste the data,
  Set oRng = oWs.Range(Cells(cloFirstRow, iSecondCol + 1), _
    Cells(loRow, iSecondCol + 1))
  'Paste the resulting column to worksheet.
  oRng = SmallArray

'  str1 = "Results of the Range"
'  For loArr = 1 To oRng.Rows.Count
'    If Not IsError(oRng.Cells(loArr, 1)) Then
'      str2 = oRng.Cells(loArr, 1)
'     Else
'      'VBA Error Handling
'      str2 = VbaErrorCell(oRng.Cells(loArr, 1))
'    End If
'    str1 = str1 & vbCrLf & str2
'  Next
'  Debug.Print str1

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  'Status
    'The resulting data has been pasted from SmallArray to the resulting
    'column in the worksheet.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

End Sub
'-------------------------------------------------------------------------------
Function VbaErrorCell(rCell As Range) As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Description
  'Converts a VBA error (variant) IN A RANGE to an Excel error value (string).
'Arguments
  'rCell
    'A cell range with a possible VBA error.
      'If cell range contains more than one cell, the first cell is used.
'Returns
  'An Excel error value (string) if the cell contains an error value, "" if not.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Const cVErrLeft As String = "Error 20" 'Debug VBA Error Variable
  Const cStrNewError As String = "New Error. Update this Function!"
  Const cStrNoError As String = ""

''''''''''''''''''''''''''''''''''''''''
  Dim strCStr As String 'The rCell Value Converted to a String
  Dim strRes As String 'One of the Excel Cell Error Values

''''''''''''''''''''''''''''''''''''''''
  strCStr = Left(CStr(rCell(1, 1)), Len(cVErrLeft))
  If strCStr = cVErrLeft Then
    Select Case Right(CStr(rCell), 2)
      Case "00": strRes = "#NULL!"
      Case "07": strRes = "#DIV/0!"
      Case "15": strRes = "#VALUE!"
      Case "23": strRes = "#REF!"
      Case "29": strRes = "#NAME?"
      Case "36": strRes = "#NUM!"
      Case "42": strRes = "#N/A"
      Case Else: strRes = cStrNewError 'New Error.
    End Select
   Else
     strRes = cStrNoError 'Not a VBA Error
  End If
  VbaErrorCell = strRes

''''''''''''''''''''''''''''''''''''''''
End Function
'-------------------------------------------------------------------------------
Function VbaErrorString(strString As Variant) As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Description
  'Converts a VBA error (variant) IN A STRING to an Excel error value (string).
'Arguments
  'strString
    'A string with a possible VBA Error.
'Returns
  'An Excel error value (string) if the cell contains an error value, "" if not.

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Const cVErrLeft As String = "Error 20" 'Debug VBA Error Variable
  Const cStrNewError As String = "New Error. Update this Function!"
  Const cStrNoError As String = ""

''''''''''''''''''''''''''''''''''''''''
  Dim strCStr As String 'The strString Value Converted to a String
  Dim strRes As String 'One of the Excel Cell Error Values

''''''''''''''''''''''''''''''''''''''''
  strCStr = Left(CStr(strString), Len(cVErrLeft))
  If strCStr = cVErrLeft Then
    Select Case Right(CStr(strString), 2)
      Case "00": strRes = "#NULL!"
      Case "07": strRes = "#DIV/0!"
      Case "15": strRes = "#VALUE!"
      Case "23": strRes = "#REF!"
      Case "29": strRes = "#NAME?"
      Case "36": strRes = "#NUM!"
      Case "42": strRes = "#N/A"
      Case Else: strRes = cStrNewError 'New Error.
    End Select
   Else
     strRes = cStrNoError 'Not a VBA Error
  End If
  VbaErrorString = strRes

''''''''''''''''''''''''''''''''''''''''
End Function
'-------------------------------------------------------------------------------

另外,鉴于自动化可以自动更新单元格,您可能希望将以下代码放入工作表代码窗口中:

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  XthColumnResult
End Sub

理想的解决方案应该是使用Change事件,但是它会引发“运行时错误28:堆栈空间不足”,因此我改用SelectionChange事件。
我能找到的唯一缺点是,当您删除带有“ del”的单元格时,移出该单元格之前不会更新第三列中的值。
一如既往地为“过度评论”感到遗憾。

答案 2 :(得分:-1)

假定您实际上并没有理由在VBA中执行此操作(因为您的问题中未包含任何代码),您只需要一个简单的工作表公式即可。

如果列AB包含您需要比较的数据,从行3开始(如您的示例所示),请在单元格C3中输入以下公式:

=IF(A3&B3="","",A3=B3)

...然后根据需要复制/粘贴(“填充”)公式。

如果A和B列的连接值是空白,则返回空字符串(""),否则返回A和B列的比较(TRUEFALSE


顺便说一句,如果不是要求“如果空白则不返回任何内容”,那么该公式将尽可能简单:

=A3=B3