Question

我有

的错误消息

类型不匹配

在If Year(.Range("AJ" & X).Value2) = 2015 Then

行

宏显示Year(.Range("AJ" & X).Value2)等于错误2042，我不知道该如何处理。

完整的代码在这里：

Sub WintelPatch()
'// Declare your variables.
Dim wSheet1 As Worksheet, _
wSheet2 As Worksheet, _
wSlastRow As Long, _
X As Long, _
wkbSourceBook As Workbook, _
wkbCrntWorkBook As Workbook, _
worksheetName As String, _
Default As String

Set wkbCrntWorkBook = ActiveWorkbook
'// Set here Workbook(Sheets) names
Set wSheet2 = wkbCrntWorkBook.ActiveSheet

'extract data from another excel file
With Application.FileDialog(msoFileDialogOpen)
.Filters.Clear
.Filters.Add "Excel 2007-13", "*.xlsx; *.xlsm; *.xls"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count > 0 Then

    'Prompts user to choose which Worksheet they want to copy from
    MSG1 = MsgBox("Do you wish to copy from 'Overall details' ?", vbYesNo, "Name of Worksheet")
    If MSG1 = vbYes Then
        worksheetName = "Overall details"
    Else
        Default = "Sheet"
        worksheetName = Application.InputBox("Enter the name of Worksheet (Case-sensitive)", Default, Default)
    'End of first If statement
    End If

    Set wkbSourceBook = Workbooks.Open(.SelectedItems(1))
    Set wSheet1 = wkbSourceBook.Sheets(worksheetName)

    With wSheet1
    '// Here lets Find the last row of data
    wSlastRow = .Rows(.Range("B:B").Rows.Count).End(xlUp).Row

    '// Now Loop through each row
    For X = 2 To wSlastRow
    'insert wSlastRow no of rows to worksheet Summary
    'wSheet1.Rows(wSlastRow).Insert Shift:=xlDown
    If Not IsError(.Range("AJ" & X).Value2) Then
        If IsDate(.Range("AJ" & X).Value2) Then
            If Year(.Range("AJ" & X).Value2) = 2015 Then
                .Range("B" & X).Copy Destination:=wSheet2.Range("B" & X)
                .Range("AJ" & X).Copy Destination:=wSheet2.Range("J" & X)
            End If
        ElseIf IsDate("01-" & .Range("AJ" & X).Value2) Then
            If Year("01-" & .Range("AJ" & X).Value2) = 2015 Then
                .Range("B" & X).Copy Destination:=wSheet2.Range("B" & X)
                .Range("AJ" & X).Copy Destination:=wSheet2.Range("J" & X)
            End If
        End If
    End If
    Next X

    End With
    wkbSourceBook.Close False
End If
End With

'Free objects
Set wkbCrntWorkBook = Nothing
Set wSheet2 = Nothing
Set wkbSourceBook = Nothing
Set wSheet1 = Nothing

'// Simple Msg Box
MsgBox "Copy & Paste is Done."
End Sub

这是B和AJ列中的数据，它们是我的宏需要复制到另一个工作表的主机名和日期（示例数据供您参考）：

Answer 1

您应该先检查单元格是否包含日期：

For X = 2 To wSlastRow
    'insert wSlastRow no of rows to worksheet Summary
    'wSheet1.Rows(wSlastRow).Insert Shift:=xlDown
    If Not IsError(.Range("AJ" & X).Value2) Then
        If IsDate(.Range("AJ" & X).Value2) Then
            If Year(.Range("AJ" & X).Value2) = 2015 Then
                .Range("B" & X).Copy Destination:=wSheet2.Range("B" & X)
                .Range("AJ" & X).Copy Destination:=wSheet2.Range("J" & X)
            End If
        ElseIf IsDate("01-" & .Range("AJ" & X).Value2) Then
            If Year("01-" & .Range("AJ" & X).Value2) = 2015 Then
                .Range("B" & X).Copy Destination:=wSheet2.Range("B" & X)
                .Range("AJ" & X).Copy Destination:=wSheet2.Range("J" & X)
            End If
        End If
    End If
Next X

Answer 2

我认为我们不需要这么多检查。如果您的单元格类型为Date，则此代码也应该有效：

For X = 2 To wSlastRow
    If IsDate(.Range("AJ" & X)) Then
        If Year(.Range("AJ" & X)) = 2015 Then
            .Range("B" & X).Copy Destination:=wSheet2.Range("B" & X)
            .Range("AJ" & X).Copy Destination:=wSheet2.Range("J" & X)
        End If
    End If
Next X

输入年份值类型不匹配

2 个答案: