Astuces Excel
  1. Astuces Excel
  3. comment changer l'location de sortie pour chaque boucle et exécuter plusieurs loops
Intereting Posts
Excel VBA ajoute des espaces aux cellules Comment modifier les valeurs par défaut d'une ligne insérée d'une table Excel? Excel Solver avec plus de 100 contraintes Solver provoque une erreur "Excel a cessé de fonctionner" Créer un path général pour le file partagé VBA dans MS Outlook pour filterr par date et sujet, extraire la pièce jointe, save et replace le file précédent dans le dossier Trouver et replace une string dans tous les classurs Excel dans un directory Excel – changement de DSN embeeded Utilisation d'une macro de feuille de copy VBA et d'une formule r1c1 Comment puis-je automatiser l'import et le formatting d'un file text? Empêcher que les cases à cocher ne soient vérifiées / non cochées Utilisation d'une macro VBA pour find la date la plus importante Déploiement d'addins Excel Mode d'écriture plus rapide pour chaque déclaration dans VBA L'object de la feuille de calcul dans le tableau est-il automatiquement supprimé?

comment changer l'location de sortie pour chaque boucle et exécuter plusieurs loops

J'ai un code ici qui suit une list de files; en les ouvrant, en extrayant des données et en la transférant dans le classur principal. Ce que je cherche à le faire, datatables pour abel sont dans les colonnes c et d, mais mettent varo en f et g, etc. Le problème que je vois est que le code de placement est dans la boucle, donc, pour chaque i, il sera juste écrire sur la ligne précédente au lieu d'être dans une autre colonne tous set! 

Sub Source_Data() Dim r Dim findValues() As Ssortingng Dim Wrbk As Workbook Dim This As Workbook Dim sht As Worksheet Dim i Dim tmp Dim counter Dim c As Range Dim firstAddress Dim rng As Range ReDim findValues(1 To 3) findValues(1) = "abel" findValues(2) = "varo" findValues(3) = "Tiger" counter = 0 r = Range("A1").End(xlDown).Row Set rng = Range(Cells(1, 1), Cells(r, 1)) Set This = ThisWorkbook For Each tmp In rng Workbooks.Open tmp Set Wrbk = ActiveWorkbook Set sht = ActiveSheet For i = 1 To 3 With sht.Range(Cells(1, 1), Range("A1").SpecialCells(xlCellTypeLastCell)) Set c = .Find(findValues(i), LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Offset(0, 2).Value Do This.Activate tmp.Offset(0, 2).Value = tmp.Value tmp.Offset(0, 3).Value = firstAddress Set c = .FindNext(c) counter = counter + 1 Loop While Not c Is Nothing And c.Value = firstAddress End If End With Wrbk.Activate Next Wrbk.Close Next tmp End Sub

** EDIT: ** Je sais que cela peut être fait en ajoutant un multiplicateur de "i" à la valeur de décalage, mais cela rend les choses plus importantes qu'il le faut si je souhaite searchr 50 mots-keys

Voici ma réponse, j'espère vous aider, et comme toujours, si vous avez besoin d'une amélioration, dites-moi simplement. 

 Sub Source_Data() Dim r Dim findValues() As Ssortingng Dim Wrbk As Workbook Dim This As Workbook Dim sht As Worksheet Dim i Dim tmp Dim counter Dim c As Range Dim firstAddress Dim rng As Range Dim ColNum 'the columns number var ReDim findValues(1 To 3) findValues(1) = "abel" findValues(2) = "varo" findValues(3) = "Tiger" counter = 0 r = Range("A1").End(xlDown).Row Set rng = Range(Cells(1, 1), Cells(r, 1)) Set This = ThisWorkbook For Each tmp In rng Workbooks.Open tmp Set Wrbk = ActiveWorkbook Set sht = ActiveSheet For i = 1 To 3 With sht.Range(Cells(1, 1), Range("A1").SpecialCells(xlCellTypeLastCell)) Set c = .Find(findValues(i), LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Offset(0, 2).Value Do This.Activate Select Case i 'Test var i (the value) Case "abel" 'in case the value (that is a ssortingng) is equal to... ColNum = 1 'set the var, with the number of the column you want Case "varo" 'in case the value... ColNum = 2 'Set the column... Case "Tiger" ColNum = 3 Case Else 'In case that the i var not match with anyvalue take this column number ColNum = 20 'the garbage! End Select tmp.Offset(0, ColNum).Value = tmp.Value 'Put the value in the selected columns tmp.Offset(0, ColNum + 1).Value = firstAddress 'and put the value to the next column of the 'selected column Set c = .FindNext(c) counter = counter + 1 Loop While Not c Is Nothing And c.Value = firstAddress End If End With Wrbk.Activate Next Wrbk.Close Next tmp End Sub

Remarque: Vous devez définir ColNum var aux valeurs dont vous avez besoin, mettez là les nombres des colonnes dont vous avez vraiment besoin pour stocker la valeur de i et la ligne suivante consiste à mettre l'adresse du i var

Vous pouvez simplement modifier ces deux lignes: 

 tmp.Offset(0, 2).Value = tmp.Value tmp.Offset(0, 3).Value = firstAddress

Pour ça 

 tmp.Offset(0, 2 + (i-1)*2).Value = tmp.Value tmp.Offset(0, 3 + (i-1)*2).Value = firstAddress