使用匹配功能查找用作文件名的文本

时间:2018-08-27 12:49:35

标签: excel excel-vba

我正在尝试使用match函数来引用包含新文件名的单元格。

Sub SaveAs()

    Dim FName           As String
    Dim FPath           As String
    Dim NewBook         As Workbook

    FPath = "\\G:\Exceptions"
    FName = (Application.Match("Test", Worksheets("Sheet 1").Range("A1:A42"), 0, 2)) & ".xls"

    If Dir(FPath & "\" & FName) <> "" Then
        MsgBox "File " & FPath & "\" & FName & " already exists"
    Else
        ThisWorkbook.SaveAs filename:=FPath & "\" & FName
    End If

End Sub

可以做到这一点,还是我更好地找到另一种方式来做到这一点?

2 个答案:

答案 0 :(得分:0)

Match返回一个Long,在1维范围内的相对位置。您将需要将该数字与其他名称一起使用,例如<iframe src="https://www.google.com/maps/@52.047652,1.1568687,14z"width="400" height="400"> </iframe> ,以返回实际名称。

Cells()

现在另一件事。如果找不到匹配项,您将要处理该错误:

Sub SaveAs()

    Dim Mtch as Long
    Dim FPath           As String
    Dim NewBook         As Workbook

    FPath = "\\G:\Exceptions"
    Mtch = (Application.Match("Test", Worksheets("Sheet 1").Range("A1:A42"), 0)) & ".xls"

    If Dir(FPath & "\" & Worksheets("Sheet 1").Cells(Mtch,2).Value) <> "" Then
        MsgBox "File " & FPath & "\" & FName & " already exists"
    Else
        ThisWorkbook.SaveAs filename:=FPath & "\" & FName
    End If

End Sub

答案 1 :(得分:0)

按照斯科特的答案:

第一个错误与您的比赛有关。

Application.Match("Test", Worksheets("Sheet 1").Range("A1:A42"), 0, 2))

需要成为

Application.Worksheetfunction.Match("Test", Worksheets("Sheet 1").Range("A1:A42"), 0)

“匹配”还返回一个很长的字符,因此您需要添加Cells()来查找所需的名称

Cells(Application.Worksheetfunction.Match("Test", Worksheets("Sheet 1").Range("A1:A42"), 0),2).value

为您提供所需的名称

现在,如果您添加找不到匹配项的情况,您将得到以下代码:

Sub SaveAs()

    Dim FName           As String
    Dim FPath           As String
    Dim NewBook         As Workbook
    Dim Mtch            As Long

    FPath = "\\G:\Exceptions"
    Mtch = Application.WorksheetFunction.Match("Test", Worksheets("Sheet 1").Range("A1:A42"), 0)
    FName = Cells(Application.WorksheetFunction.Match("Test", Worksheets("Sheet 1").Range("A1:A42"), 0), 2) & ".xls"
    MsgBox FName

    If Not IsError(Mtch) Then
        If Dir(FPath & "\" & Worksheets("Sheet 1").Cells(Mtch, 1).Value) <> "" Then
            MsgBox "File " & FPath & "\" & FName & " already exists"
        Else
            ThisWorkbook.SaveAs Filename:=FPath & "\" & FName
        End If
    Else
        MsgBox "the value not found in the column"
    End If

End Sub

或者,您也可以找到像这样的行:

Mtch = Findval("TEST", Range("A1:A42"))

MsgBox Mtch
FName = Cells(Application.WorksheetFunction.Match("Test", Worksheets("Sheet 1").Range("A1:A42"), 0), 2) & ".xls"
MsgBox FName


If Not IsError(Mtch) Then
    If Dir(FPath & "\" & Worksheets("Sheet 1").Cells(Mtch, 1).Value) <> "" Then
        MsgBox "File " & FPath & "\" & FName & " already exists"
    Else
        ThisWorkbook.SaveAs Filename:=FPath & "\" & FName
    End If
Else
    MsgBox "the value not found in the column"
End If

End Sub


Function Findval(VALUESEARCHED As String, ra As Range) As Variant

Dim A As Range

    Set A = ra.Find(What:=VALUESEARCHED, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

Findval = A.Row

End Function