Reference a cell if the sheet contains a certain string using VBA

问题

the code below copies "ADXL364" sheet in my active worksheet, but is there way that I can copy the sheet if it contains "XL364" or "364"

if I put asterisk 'C:\data[adxl364.xls]*ADXL364_QC'!A1 in my code it does not work.

Sub GetRange()
    With Range("A:Z")
        .Formula = "=If('C:\data\[adxl364.xls]ADXL364_QC'!A1 > 0,'C:\data\[adxl364.xls]ADXL364_QC'!A1,Text(,))"
        .Formula = .Value
    End With
    End Sub

the long code will be getting the location of file from the user then copying a worksheet that contains ADXL364 or XL364

With ActiveWorkbook
    Sheets.Add.Name = "Flow_table"
    Application.EnableEvents = False

    TP_location = Left(TextBox1.Value, InStrRev(TextBox1.Value, "\"))
    TP_filename = Right(TextBox1.Value, Len(TextBox1.Value) - InStrRev(TextBox1.Value, "\"))
    TP_filename = "[" & TP_filename & "]"
    TP_formula = "'" & TP_location & TP_filename & TextBox2.Value & "'!A1"

    getcellvalue = "=if(" & TP_formula & ">0," & TP_formula & "," & """"")"

        With Range("A:Z")
        .Formula = getcellvalue
        .Formula = .Value
        End With

    Sheets.Add.Name = "Job_lists"

End With
Unload UserForm2
End Sub

回答1:

An ugly, but possible, way would be with a brute force error trapping technique.

However, a more elegant solution might be to use ADO. You could for example run two 'queries': the first on the table schema which would give you your sheet names in the specified file, and the second on the found sheet name. This would produce a RecordSet containing the data of your closed sheet which can be written directly to a Range using the .CopyFromRecordset method. Of course, you could just run the first query to find your sheet name and move on as you have in your posted code.

The example below shows the code for the two queries. It's all late bound so you needn't reference the ADO library but I'll leave that decision to you. I've put a few constants at the top of the module which might need changing depending on which version of Excel you have. You'll also need to write your own error handling (especially to close the connection) but, again, I'll leave that one for you.

Option Explicit
Private Const SCHEMA_TABLES As Integer = 20
Private Const OPEN_FORWARD_ONLY As Integer = 0
Private Const LOCK_READ_ONLY As Integer = 1
Private Const CMD_TEXT As Long = 1
Private Const PROVIDER As String = "Microsoft.ACE.OLEDB.12.0"
Private Const XL_PROP As String = """Excel 12.0;HDR=No"""
Private Const SHEETS_FIELD_NAME As String = "TABLE_NAME"

Public Sub AcquireData()
    Dim fPath As String
    Dim fName As String
    Dim key As String
    Dim addr As String
    Dim oConn As Object
    Dim oRS As Object
    Dim connString As String
    Dim sql As String
    Dim found As Boolean
    Dim sheetField As String

    'Define the path and file name
    fPath = "C:\Users\User\Documents\StackOverflow"
    fName = "closed_book.xlsx"

    'Define the search key
    key = "XL364"

    'Define the address of closed worksheet
    'If reading one cell then use [address:address], eg "A1:A1"
    addr = "A1:E5"

    'Late bind the ADO objects
    Set oConn = CreateObject("ADODB.Connection")
    Set oRS = CreateObject("ADODB.Recordset")

    'Open conection
    connString = "Provider=" & PROVIDER & ";" & _
                 "Data Source=" & fPath & "\" & fName & ";" & _
                 "Extended Properties=" & XL_PROP & ";"

    oConn.Open connString

    'Search for the sheet name containing your key
    'in the tables (ie sheets) schema
    found = False
    oRS.Open oConn.OpenSchema(SCHEMA_TABLES)
    Do While Not oRS.EOF
        sheetField = oRS.Fields(SHEETS_FIELD_NAME).Value
        If InStr(sheetField, key) > 0 Then
            found = True
            Exit Do
        End If
        oRS.MoveNext
    Loop
    oRS.Close

    'Read the target data
    If found Then
        sql = "SELECT * FROM [" & _
              sheetField & addr & "];"

        oRS.Open sql, oConn, OPEN_FORWARD_ONLY, LOCK_READ_ONLY, CMD_TEXT

        'Write the data to your worksheet
        If Not oRS.EOF Then
            ThisWorkbook.Worksheets("Sheet1").Range("A1") _
                .CopyFromRecordset oRS
        End If

    End If


    'Housekeeping
    oRS.Close
    Set oRS = Nothing
    oConn.Close
    Set oConn = Nothing

End Sub

回答2:

You can test if the text "XL364" is in the sheet name by looping through each sheet and using the InStr (in string) function. e.g.:

For Each ws in Workbooks.Open(filepathStringFromUserInput)
    If InStr(1, ws.Name, "XL364") > 0 Then
        MsgBox "hi"
        'Set hwSheet = ws
    End If
Next ws


With hwSheet
    'do some code eg:
    .Range("A1").Value = "Hi"
End With

来源：https://stackoverflow.com/questions/38783448/reference-a-cell-if-the-sheet-contains-a-certain-string-using-vba

标签

excel

vba

excel-vba

copy