查找循环无法正常工作

时间:2016-08-07 01:45:41

标签: loops find

我正在尝试为Mac Office 2011设计一个vba宏脚本,该脚本使用A列中的find来查找用户先前选择的文件名。

用户选择.csv文件,然后宏查看A列以查找不带.csv扩展名的文件名。找到后,它会偏移一列(到B列)并导入csv信息。

我目前所拥有的不是查找​​然后选择?我似乎无法弄清楚我在这里做错了什么。

csv将导入,但只是在运行宏之前我已经激活的单元格旁边。这就是为什么我认为Find不起作用。

非常感谢任何帮助。

Sub CSVauto()
'
' CSVauto Macro
'
' Keyboard Shortcut: Option+Cmd+x
'
'   Declaring and setting variables for choosing CSV to import
    Dim csvFileName As Variant


''Prompt window to choose csv file
csvFileName = Application.GetOpenFilename(FileFilter:="")
If csvFileName = False Then Exit Sub
'Setting a variable to find Experimental form name in Data Summary
Dim whatToFind As String 'Declaring that variable
    If Right(csvFileName, 4) = ".csv" Then
        whatToFind = Replace(csvFileName, ".csv", "")
    Else
        MsgBox "Selected File Not .csv)"
    End If
'Looping through A column to find csvFileName without .csv extension
Set cell = Range("A:A").Find(What:=whatToFind, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False)

If Not cell Is Nothing Then
        cell.Select
    End If

'Speeding macro up by making it work in background
 Sheets("DataSummary").DisplayPageBreaks = False
 Application.DisplayAlerts = False

Dim MyRange As Range
Set MyRange = ActiveCell.Offset(0, 1)

MyRange.Select

 'xlOverwriteCells

 On Error Resume Next

'Formatting for CSV and input
With MyRange.Parent.QueryTables.Add(Connection:="TEXT;" & csvFileName, Destination:=MyRange)
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = xlMacintosh
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = True
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = True
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
        .Refresh BackgroundQuery:=False
        .UseListObject = False
    End With

 'Formatting DataSummary sheet to fit "requirements" :)
    Cells.Replace What:=">=", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByColumns, MatchCase:=False
    Cells.Replace What:="C121", Replacement:="C2", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False
    Cells.Replace What:="P1211", Replacement:="P21", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=False

    Cells.Select
    With Selection
        .HorizontalAlignment = xlLeft
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
    End With

    Range("A4").Select
      ' Set Do loop to stop when an empty cell is reached.
      Do Until IsEmpty(ActiveCell)
         ' Insert your code here.
         ' Step down 1 row from present location.
         ActiveCell.Offset(1, 0).Select
      Loop

    'undoing everything working in background
    Sheets("DataSummary").DisplayPageBreaks = True
    Application.ScreenUpdating = True



End Sub

1 个答案:

答案 0 :(得分:1)

看看你在哪里"设置单元格= ...."你正在寻找whatToFind。

在上面的if / else语句中,你永远不会在" else"中设置whatToFind。声明。如果我正确地阅读您的请求,您需要在else语句中将whatToFind设置为某些内容。

在我看来,你要的是找到一个不是.csv的文件,然后执行搜索/偏移功能。

如果我错了请纠正我,或请澄清。

修改

此代码应该适合您。我用你的代码尝试了它,它插在if / else语句下面

Dim filename As Variant filename = Mid(whatToFind, InStrRev(whatToFind, "/") + 1) MsgBox filename