Excel VBA 使用工作表函数查找重复代码错误类型不匹配

Question

我得到一个

Type Mismatch Error "13"

使用以下代码。任何人都可以帮助我的 VBA 语法和变量使用出错的地方。

If Application.WorksheetFuntion.CountIf(Target, r.Value) > 1 Then

我已经尝试了 matchFoundIndex 代码方法但没有成功...可能是由于不正确的 VBA 语法。

CountIf 行的目的是在 A 列中查找重复项。其余代码遍历文件和工作表，复制文件名、工作表名称和单元格 C1 以供进一步分析。我是编码方面的新手，我确定可能存在我未使用的 Dimmed 变量、其他格式以及我尚未发现的错误。任何帮助将不胜感激。

Sub CopyFileAndStudyName()

Dim sPath As String, SName As String
Dim xlWB As Workbook
Dim sh As Worksheet
Dim lngRow As Long
Dim lngwsh As Long
Dim xlApp As Excel.Application
Dim sfile As String
Dim wbk As Workbook
Dim iCntr As Long
Dim matchFoundIndex As Long
Dim FindDuplicates As Boolean
Dim IsDup As Boolean

sPath = "C:\Users\mypath\"

' which row to begin writing to in the activesheet
lngRow = 2

SName = Dir(sPath & "*.xlsx") ' for xl2007 & "*.xls"
Set xlApp = New Excel.Application
xlApp.Visible = False

If MsgBox("Are you sure you want to copy all the file and Cell C1 in " & sPath & "?", vbYesNo) = vbNo Then Exit Sub

Do While SName <> ""
    lngwsh = 1
    ' Will cycle through all .xlsx files in sPath
    Set xlWB = xlApp.Workbooks.Open(sPath & SName, , True) ' opens in read-only mode
    ' Will cycle through first 3 of the worksheets in each file copying file name and cell C1 in columns C and D
        For lngwsh = 1 To 3
            Set sh = ActiveSheet
            sh.Cells(lngRow, "A") = xlWB.Name
            sh.Cells(lngRow, "B") = xlWB.Worksheets(lngwsh).Range("C1")
            sh.Cells(lngRow, "C") = xlWB.Sheets(lngwsh).Name

            Dim Target As Range
            Dim r As Range
            Dim lastRow As Long
            Dim ws As Worksheet

            Set ws = xlWB.Worksheets(lngwsh)

            With ws
                lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
                Set Target = ws.Range("A1:A" & lastRow)
            End With
                For Each r In Target
                        If r.Value <> "" Then
                            If Application.WorksheetFunction.CountIf(Target, r.Value) > 1 Then
                                FindDuplicates = True
                                Exit For
                            Else
                                FindDuplicates = False
                            End If
                        End If
                Next r

            Debug.Print FindDuplicates

            IsDup = FindDuplicates

            sh.Cells(lngRow, "D") = IsDup
            FindDuplicates = False

               End If
 lngRow = lngRow + 1
 Next lngwsh

 xlWB.Close False
 xlApp.Quit
 SName = Dir()
 Loop
 MsgBox "Report Ready!"
 End Sub

Answer 1

如果要检查范围内的重复项，可以使用 Dictionary 对象。

Dim Dict As Object

Set Dict = CreateObject("Scripting.Dictionary")

For Each r In Target
    If Trim(r.Value) <> "" Then
        If Not Dict.exists(r.Value) Then  ' not found in dictionary >> add Key
            Dict.Add r.Value, r.Value
            FindDuplicates = False               
        Else ' found in Dictionary >> Exit
            FindDuplicates = True
            Exit For
         nd If
    End If
Next r

Answer 2

Sub CopyFileAndStudyName()

Dim sPath As String, SName As String
Dim xlWB As Workbook
Dim sh As Worksheet
Dim lngRow As Long
Dim lngwsh As Long
Dim xlApp As Excel.Application
Dim sfile As String
Dim wbk As Workbook
Dim iCntr As Long
Dim matchFoundIndex As Long
Dim FindDuplicates As Boolean
Dim IsDup As Boolean

sPath = "C:\Users\mypath\"

' which row to begin writing to in the activesheet
lngRow = 2

SName = Dir(sPath & "*.xlsx") ' for xl2007 & "*.xls"
Set xlApp = New Excel.Application
xlApp.Visible = False

If MsgBox("Are you sure you want to copy all the file and Cell C1 in " & sPath & "?", vbYesNo) = vbNo Then Exit Sub

Do While SName <> ""
lngwsh = 1
' Will cycle through all .xlsx files in sPath
Set xlWB = xlApp.Workbooks.Open(sPath & SName, , True) ' opens in read-only mode
' Will cycle through first 3 of the worksheets in each file copying file name and cell C1 in columns C and D

     For lngwsh = 1 To 3
        Set sh = ActiveSheet
        sh.Cells(lngRow, "A") = xlWB.Name
        sh.Cells(lngRow, "B") = xlWB.Worksheets(lngwsh).Range("C1")
        sh.Cells(lngRow, "C") = xlWB.Sheets(lngwsh).Name

        Dim Target As Range
        Dim r As Range
        Dim lastRow As Long
        Dim ws As Worksheet

        Set ws = xlWB.Worksheets(lngwsh)

        With ws
            lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
            Set Target = ws.Range("A1:A" & lastRow)
        End With
            For Each r In Target
                    If r.Value <> "" Then
                        If Application.WorksheetFunction.CountIf(Target, r.Value) > 1 Then
                            FindDuplicates = True
                            Exit For
                        Else
                            FindDuplicates = False
                        End If


                    End If
            Next r

        Debug.Print FindDuplicates

        IsDup = FindDuplicates

        sh.Cells(lngRow, "D") = IsDup
        FindDuplicates = False


lngRow = lngRow + 1
Next lngwsh
xlWB.Close False
xlApp.Quit
SName = Dir()
Loop
MsgBox "Report Ready!"
End Sub

Answer 3

我在使用 CountIF 并传递给它一个范围时也有类似的经历。就我而言，我使用的是：

i = Application.WorksheetFunction.CountIf(ws.UsedRange, r.Value)

这给我一个 类型不匹配 错误。我已经看到其他人在 Range() 中包装的第一个参数取得了成功，所以经过几次尝试后我发现这可行：

i = Application.WorksheetFunction.CountIf(Range(ws.UsedRange.Address), r.Value)

所以，我建议您将代码更改为这样，看看它是否有效：

If Application.WorksheetFuntion.CountIf(Range(Target.Address), r.Value) > 1 Then

Excel VBA 使用工作表函数查找重复代码错误类型不匹配

Excel VBA code error type mismatch using worksheetfunction to find duplicates

excel

vba

duplicates

worksheet-function