La boucle de recherche ne fonctionne pas correctement - boucle, recherche

J'essaie de concevoir un script de macro vba pour Mac Office 2011 qui utilise la recherche dans la colonne A pour trouver un nom de fichier précédemment sélectionné par l'utilisateur.

L'utilisateur sélectionne un fichier .csv, puis la macro parcourt la colonne A pour trouver le nom de fichier sans extension .csv. Une fois trouvé, il se décale d'une colonne (vers la colonne B) et importe les informations csv.

Ce que j'ai actuellement ne fait pas la recherche, puis la sélection? Je n'arrive pas à comprendre ce que je fais mal ici.

Le csv sera importé, mais juste à côté de la cellule que j'avais active avant d'exécuter la macro. C'est pourquoi je pense que la recherche ne fonctionne pas.

Toute aide serait appréciée.

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

Réponses:

Jetez un oeil à l'endroit où vous "Set cell = ...." vous l'avez chercher whatToFind.

Dans votre instruction if / else au-dessus de cela, vous ne définissez jamais whatToFind dans l'instruction "else". Vous devez définir whatToFind comme quelque chose dans l'instruction else, si je lis correctement votre demande.

Il me semble que ce que vous demandez est de trouver un fichier qui n'est PAS un .csv puis d'effectuer la fonction de recherche / décalage.

Veuillez me corriger si je me trompe ou clarifier.

MODIFIER

Ce code devrait fonctionner pour vous. Je l'ai essayé avec votre code avec ceci inséré juste en dessous de l'instruction if / else

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