Astuces Excel
  1. Astuces Excel
  3. VBA – Erreur hors limites
Intereting Posts
Ligne de time – feuille de remplissage avec les dates manquantes entre l'intervalle donné Créez un nouveau Excel par rapport à l'existant L'ajout de nom crée une erreur "l'object invoqué s'est déconnecté de ses clients" Trouver une ID dans une feuille commune à une autre feuille dans un autre classur Excel: append des éléments à la list déroulante Extraction de nombres VLookup ne renvoie pas les résultats L'Excel se bloque lorsque la macro est exécutée à partir de l'interface VBA, mais fonctionne lorsque vous utilisez un button Recherche d'une valeur dans une colonne spécifiée Comment ouvrir un file dans un classur actif? VB.NET 2008 Définition de la list déroulante de validation par VBA dans Excel Formule pour faire correspondre une cellule à plusieurs rangées, y compris une cellule vide Mise à jour automatique du graphique dans VBA vb excel error 1004 Selection.PasteSpecial Remplacer une string dans la colonne C en fonction de l'index correspondant dans la colonne A Partie 2

VBA – Erreur hors limites

J'essaie d'écrire une macro pour effectuer les opérations suivantes:

  1. Demandez à l'user d'ouvrir son file, puis ajoutez une nouvelle feuille "Mismatch" au file
  2. Trouvez le nom de la colonne "Cust Bill To ID" et "SAP CMF #" et stockez datatables sous ces deux colonnes dans 2 arrays différents [BTID () & CMF ()].
  3. Si BTID (i) n'est pas égal à CMF (i), copyz la ligne entière et collez-la sur la feuille Mismatch.

Mais les arrays ayant l'erreur hors-gamme de la session et la feuille incompatibles n'ont que le nom de la colonne en double depuis la feuille d'origine (datatables sont manquantes).

Résultat:
entrez la description de l'image ici

Code: 

Sub Mismatch() Dim sht As Worksheet Dim authSht As Worksheet ' Renamed this variable Dim misSht As Worksheet ' Added a worksheet variable Dim i As Integer Dim k As Integer Dim last As Integer Dim BTID() As Ssortingng Dim CMF() As Ssortingng Dim rng1 As Range ' Added this variable Dim rng2 As Range ' Added this variable ''OPEN FILE sFileName = Application.GetOpenFilename("Excel Files (*.xls;*.xlsx;*.xlsm;*.xla;*.xlam),*.xls;*.xlsx;*.xlsm;*.xla;*.xlam, All Files (*.*), *.*", 1, "Select Authorization Issued Report File") If sFileName = "False" Then Exit Sub Application.DisplayAlerts = False Set auth = Workbooks.Open(sFileName, UpdateLinks:=xlUpdateLinksNever) 'add new sheet Set sht = Sheets.Add sht.Name = "Mismatch" Sheets("Mismatch").Select With ActiveWorkbook.Sheets("Mismatch").Tab .Color = 255 .TintAndShade = 0 End With Set authSht = Worksheets("Authorizations Issued") Set misSht = Worksheets("Mismatch") ''find Mismatch authSht.Range("A2:BT2").Copy Destination:=misSht.Range("A1") last = ActiveSheet.UsedRange.Rows.Count 'col = ActiveSheet.End(xlToLeft).Column Set rng1 = authSht.Range("A2:BH2") Set rng2 = rng1 For Each c In rng1.Cells If c.Value = "Cust Bill To ID" Then Set rng1 = c Next c For Each c In rng2.Cells If c.Value = "SAP CMF#" Then Set rng2 = c Next c Dim l As Integer l = 2 ReDim BTID(2 To l) ReDim CMF(2 To l) For i = 2 To last BTID(i) = rng1.Offset(i, 0).Value CMF(i) = rng2.Offset(i, 0).Value If i < last Then ReDim Preserve BTID(1 To i + 1) ReDim Preserve CMF(1 To i + 1) End If Next For k = 2 To last If BTID(k) = CMF(k) Then authSht.Range("A" & k & ":BH" & k).Copy Destination:=misSht.Range("A" & l) l = l + 1 Else: l = l End If Next misSht.UsedRange.EntireColumn.AutoFit End Sub

Et je me suis rendu count que le code ci-dessous ne fonctionne pas dans la boucle for. 

  authSht.Range("A" & k & ":BH" & k).Copy Destination:=misSht.Range("A" & l)

Quel est le problème avec ce code?

Je suis tout à fait convaincu que votre problème concerne les references de gamme ne correspondant pas entièrement et s'appuie sur ActiveSheet implicite (et ActiveWorkbook )

votre dernière sélection de feuille est 

 Sheets("Mismatch").Select

qui active une nouvelle feuille avec seulement les en-têtes placés dans la rangée 1, puis vous exécutez 

 last = ActiveSheet.UsedRange.Rows.Count

en définissant ainsi le last à 1 , de sorte que votre suite For i = 2 To last loops ne s'exécute pas une seule instruction, vous laissant avec les mains vides (bien, les cellules) dans la feuille d' Mismatch

la réparation la plus directe d'une telle situation serait de placer: 

 authSht.Activate

juste avant: 

 last = ActiveSheet.UsedRange.Rows.Count

mais le patch réel utiliserait des references de gamme entièrement qualifiées, comme suit:

replace: 

 ''find Mismatch authSht.Range("A2:BT2").Copy Destination:=misSht.Range("A1") last = ActiveSheet.UsedRange.Rows.Count 'col = ActiveSheet.End(xlToLeft).Column Set rng1 = authSht.Range("A2:BH2") Set rng2 = rng1

avec le code suivant: 

 With authSht ''find Mismatch .Range("A2:BT2").Copy Destination:=misSht.Range("A1") last = .UsedRange.Rows.Count 'col = ActiveSheet.End(xlToLeft).Column Set rng1 = .Range("A2:BH2") End With Set rng2 = rng1 '<--| what0s this for? you can stick to 'rng1'