Bonjour à tous, c'est ma première question, je ferai donc de mon mieux pour formater le mieux possible.
Description rapide sans nom de cellule spécifique ci-dessous
J'essaie d'écrire une macro dans laquelle un utilisateur entre une valeur (X) et une macro recherche une plage de cellules pour une valeur (X), puis la macro renvoie les valeurs de cellule dans les 3 espaces à côté de l'endroit où le l'emplacement de la valeur (X) est.
Deux choses qui rendent cela impossible à résoudre sont le fait que l'utilisateur entre la valeur sur Sheet1 et que la valeur est déplacée vers Sheet2 par une formule, je n'arrive pas à comprendre comment utiliser Find where the values Je recherche n'est pas déjà défini dans la macro.
L'autre chose qui rend cela difficile est que la plage n'est pas strictement définissable non plus, car la liste pourrait être plus longue ou plus courte qu'elle ne l'est actuellement, et je ne peux pas savoir quand elle changera. Ainsi, la plage de recherche doit commencer en fonction de la liste entrée par l'utilisateur et doit aller jusqu'à ce qu'elle atteigne un espace vide.
Par exemple: Range. ("C7: D10") ne fonctionnera pas car l'utilisateur pourrait entrer de nouvelles informations qui modifient la plage de travail comme décrit ci-dessous.
Ci-dessous, une capture d'écran avec des explications supplémentaires
https://i.stack.imgur.com/wlnhg.jpg
Donc, dans cette capture d'écran, les cellules C3 et D3 sont des valeurs importées de Sheet1.
C3 est (= Sheet1! B2)
D3 est (= Sheet1! B3)
L'idée est que la macro s'exécute et recherche dans la colonne A jusqu'à ce qu'elle ait une correspondance avec C3.
Ensuite, la fonction de recherche se déplace sur deux cellules et recherche vers le bas jusqu'à ce qu'elle ait une correspondance avec D3 ou jusqu'à ce qu'elle atteigne un espace vide.
Je ne sais pas comment demander à une macro d'effectuer une recherche basée sur une valeur importée, et je ne sais pas comment lui demander de rechercher cette plage étrange dont j'ai besoin. L'idée est que quelqu'un à mon travail pourrait venir et ajouter une ligne sous C10 et ajouter les informations nécessaires et la macro fonctionnerait toujours et chercherait dans C11 et il y aurait un espace vide après pour dire à la macro de s'arrêter.
Une fois que la recherche trouve une correspondance pour D3, elle renvoie les valeurs adjacentes à la correspondance aux cellules correspondantes en haut, E3, F3 et G3.
J'espère que cette question est posée d'une manière que les gens peuvent comprendre, je suis très fatigué, donc je ne peux pas dire si j'ai écrit quelque chose qui a du sens. Merci d'avoir lu mon message, vous êtes tous les meilleurs !!
4 Réponses :
Onglet Formules> Gestionnaire de noms> Sélectionnez Table / Changer le nom ) Plus précisément, vous voudrez changer les noms en nom de liste souhaité. ( Nom du tableau 1 = Liste1 & Nom du tableau 2 = Liste2 ) E3, F3 et G3 E3 = VLOOKUP(D3, Indirect(C3), 2, 0) F3 = VLOOKUP(D3, Indirect(C3), 3, 0) G3 = VLOOKUP(D3, Indirect(C3), 4, 0)
Cette mise à jour sera mise à jour dynamiquement au fur et à mesure que la taille de votre table s'agrandit. vous pouvez également ajouter autant de tables que vous le souhaitez et cela continuera à fonctionner.
En cours d'utilisation, il ressemble à quelque chose comme ci-dessous
Ma dernière suggestion serait de imbriquer chaque formule ci-dessus dans un IFERROR()
Une des raisons d'être fatigué est que vous avez essayé de tuer avant de vous préparer pour le massacre. La solution ci-dessous a pris une heure pour se préparer et 10 minutes pour coder. Collez l'intégralité du code dans un module de code standard et appelez la fonction MatchRow soit à partir de la fenêtre Exécution (? MatchRow ) soit à partir de votre propre code comme indiqué dans la procédure de test plus bas .
Private Sub RetrieveData()
Dim R As Long
R = MatchRow
MsgBox "ID = " & Cells(R, NwsID).Value & vbCr & _
"Number = " & Cells(R, NwsNumber).Value
End Sub
La fonction MatchRow renvoie le numéro de ligne de Sheet2 où se trouve D3, en recherchant uniquement la partie de la colonne D qui appartient à la liste identifiée en C3. La fonction renvoie 0 si aucune correspondance n'a été trouvée, que ce soit de la liste ou de l'ID.
Vous n'avez pas spécifié ce que vous voulez faire avec la ligne trouvée. La procédure ci-dessous renverra les données de cette ligne. Vous pouvez utiliser la capacité d'adresser les cellules pour y écrire à la place.
Option Explicit
Enum Nws ' worksheet navigation
' 01 Mar 2019
NwsCriteriaRow = 3
NwsList = 1 ' Columns: (1 = A)
NwsID = 3
NwsNumber ' (undefined: assigns next integer)
End Enum
Function MatchRow() As Long
' 01 Mar 2019
' return 0 if not found
Dim Ws As Worksheet
Dim Rng As Range
Dim R As Long
' The ActiveWorkbook isn't necessarily ThisWorkbook
Set Ws = ActiveWorkbook.Worksheets("Sheet2") ' replace tab's name here
With Ws
Set Rng = .Range(.Cells(NwsCriteriaRow, NwsList), .Cells(.Rows.Count, NwsList).End(xlUp))
R = FindRow(.Cells(NwsCriteriaRow, NwsID).Value, Rng, True)
If R Then ' skip if no match was found
Set Rng = .Cells(R + 1, NwsID)
Set Rng = .Range(Rng, Rng.End(xlDown))
MatchRow = FindRow(.Cells(NwsCriteriaRow, NwsNumber).Value, Rng)
End If
End With
End Function
Private Function FindRow(Crit As Variant, _
Rng As Range, _
Optional ByVal SearchFromTop As Boolean) As Long
' 01 Mar 2019
' return 0 if not found
Dim Fun As Range
Dim StartCell As Long
With Rng
If SearchFromTop Then
StartCell = 1
Else
StartCell = .Cells.Count
End If
Set Fun = .Find(What:=Crit, _
After:=.Cells(StartCell), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
MatchCase:=False)
End With
If Not Fun Is Nothing Then FindRow = Fun.Row
End Function
Étant destiné à tester uniquement le processus ci-dessus ne spécifie pas la feuille de calcul et, par conséquent, renvoie des données de l'ActiveSheet, supposé être Sheet2.
Téléchargement du classeur (Dropbox)
a> 
Sub SearchTwice()
Const cSheet As String = "Sheet2" ' Source Worksheet Name
Const cList As String = "C3" ' List Cell Range Address
Const cName As String = "D3" ' Name Cell Range Address
Const cListCol As String = "A" ' List Column Letter
Const cNameCol As String = "C" ' Name Column Letter
Const cFirst As Long = 6 ' First Row
Const cCol As Long = 3 ' Number of Columns
Dim rng1 As Range ' Find List Cell Range
' Found Name Cell Range
Dim rng2 As Range ' Next List Cell Range
' Name Search Range
Dim strList As String ' List
Dim strName As String ' Name
' In Source Worksheet
With ThisWorkbook.Worksheets(cSheet)
' Write from List Cell Range to List.
strList = .Range(cList)
' Write from Name Cell Range to Name.
strName = .Range(cName)
' Check if Cell Ranges do NOT contain data.
If strList = "" Or strName = "" Then ' Inform user.
MsgBox "Missing List or Name.", vbCritical, "Missing data"
Exit Sub
End If
' In List Column
With .Columns(cListCol)
' Create a reference to Find List Cell Range (rng1) containing
' List (strList).
Set rng1 = .Find(strList, .Cells(cFirst - 1), xlValues, xlWhole)
' Check if List has not been found.
If rng1 Is Nothing Then ' Inform user and exit.
MsgBox "The list '" & strList & "' has not been found", _
vbCritical, "List not found"
Exit Sub
End If
' Create a reference to Next List Cell Range (rng2).
Set rng2 = .Find("*", .Cells(rng1.Row), xlValues, xlWhole)
End With
' In Name Column
With .Columns(cNameCol)
' Check if the row of Next List Cell Range (rng2) is greater than
' the row of List Cell Range (rng1) i.e. if a cell with a value
' has been found below List Cell Range (rng1) in List Column.
If rng2.Row > rng1.Row Then ' Next List Cell Range FOUND.
' Create a reference to Name Search Range (rng2) which spans
' from the cell below Find List Cell Range (rng1) to the cell
' above the Next List Cell Range (rng2), but in Name Column.
Set rng2 = .Cells(rng1.Row + 1).Resize(rng2.Row - rng1.Row - 1)
Else ' Next List Cell Range NOT found.
' Create a reference to Name Search Range (rng2) which spans
' from the cell below Find List Cell Range (rng1) to the bottom
' cell, but in Name column.
Set rng2 = .Cells(rng1.Row + 1).Resize(.Rows.Count - rng1.Row)
End If
End With
' In Name Search Range (rng2)
With rng2
' Create a reference to Found Name Cell Range (rng1).
Set rng1 = .Find(strName, .Cells(.Rows.Count), xlValues, xlWhole)
End With
' Check if Name has not been found.
If rng1 Is Nothing Then ' Inform user and exit.
MsgBox "The name '" & strName & "' has not been found", _
vbCritical, "Name not found"
Exit Sub
End If
' Remarks:
' Source Range is calculated by moving the Found Name Cell Range (rng1)
' one cell to the right and by resizing it by Number of Columns (cCol).
' Target Range is calculated by moving the Name Cell Range one cell
' to the right and by resizing it by Number of Columns (cCol).
' Copy values of Source Range to Target Range.
.Range(cName).Offset(, 1).Resize(, cCol) _
= rng1.Offset(, 1).Resize(, cCol).Value
End With
' Inform user of succes of the operation.
MsgBox "The name '" & strName & "' was successfully found in list '" & _
strList & "'. The corresponding data has been written to the " _
& "worksheet.", vbInformation, "Success"
End Sub
Merci beaucoup! cela a été très utile
Je pense que la solution non-VBA est idéale ici, mais je la laisserai ici séparément au cas où. Cela devrait fonctionner pour votre situation en supposant qu'aucune valeur dans vos tableaux ne soit vide.
Sub Test()
Dim ws As Worksheet: Set Worksheet = ThisWorkbook.Sheets("Sheet2")
Dim iList As Range, iName As Range
Dim aLR As Long, cLR As Long
aLR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Set iList = ws.Range("A1:A" & aLR).Find(ws.Range("C3"), LookIn:=xlWhole)
If Not iList Is Nothing Then
cLR = iList.Offset(0, 2).End(xlDown).Row
Set iName = ws.Range(ws.Cells(iList.Row, 3), ws.Cells(cLR, 3)).Find(ws.Range("C4"), LookIn:=xlWhole)
If Not iName Is Nothing Then
ws.Range("E3:G3").Value = iName.Offset(0, 1).Resize(1, 3).Value
End If
End If
End Sub
Définissez ws ..., What: = ws.Range ("C3"), LookAt: = xlWhole, mais cela ne fonctionne toujours pas.
Essayez la solution non VBA - je déboguerai cela demain
Votre macro lirait simplement les valeurs de recherche à partir des cellules appropriées sur la feuille Sheet2 - peu importe si cette valeur est directement entrée dans la cellule ou est le résultat d'une formule. Avez-vous du code à partager?
@TimWilliams Non, je n'ai pas de code car je viens de quitter le travail, je suis vraiment désolé. Je donnerai du code dès que je serai au travail demain matin. Mon code est très mauvais parce que je ne connais pas vraiment VBA Je jette juste des choses ensemble, je ne suis pas un programmeur, je fais juste de mon mieux. Je ne savais pas que je devais ajouter du code, je n'ai jamais posté avant désolé.