2017-10-21 6 views
2

Je suis vraiment nouveau dans le codage VBA, actuellement j'ai une feuille de calcul contient des groupes et des comptes à différents niveaux, suivant sont un exemple simple:meilleure boucle pour mon VBA Tâche

Current Setup Image

Groupe codes sont tous les numéros et compte codes commencent par 3 lettres, disons ABC suivi par 2 ou 3 chiffres, donc un exemple serait ABC100, les 2 premiers codes de lettre de compte sont toujours les mêmes, à savoir "AB" dans l'exemple, donc un autre le code de compte pourrait être ABS80. Les codes du groupe/compte se trouvent dans une colonne distincte correspondant aux groupes/comptes .

Mon objectif est de mettre en place une macro qui me fournirait un résumé, dans un onglet séparé appelé dire résultats, de tous les groupes (UNIQUEMENT) au-dessus d'une donnée compte/Groupe dans la hiérarchie arbre, avec le sujet compte/groupe sur le fond. Donc pour illustrer en utilisant l'exemple ci-dessus. Si le sujet compte est ABC100, puis après l'exécution de la macro, je pense voir dans les résultats onglet:

Desired Result Image

Jusqu'à présent, je réussi à obtenir la macro pour trouver la position de le sujet compte dans la hiérarchie et copiez cette ligne dans l'onglet « résultats. Mais je suis coincé à l'étape suivante qui consiste à extraire uniquement les groupes de niveau supérieur directement (en même temps ignorer les comptes & groupes entre) et les coller dans l'onglet résultats.

Je sais que j'ai besoin d'utiliser la boucle et essayé For Next avec If Then instruction entre, mais continue à recevoir des messages d'erreur. Vraiment apprécier si quelqu'un pourrait me conduire à la bonne direction sur quelle boucle à utiliser.

Merci!Voici mes codes actuels:

Sub SearchRelevantAccGp() 
' 
' This macro finds the account or group and provides a summary of all affected groups 
' within the Hierarchy 

Dim searchvalue As Variant 
searchvalue = Sheets("Dashboard").Range("B2") 
Dim hierarchy As Integer 
    Sheets("Main Tree").Select 
    cells.Find(What:=searchvalue, After:=ActiveCell, LookIn:=xlFormulas, LookAt _ 
     :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ 
     False, SearchFormat:=False).Activate 
hierarchy = ActiveCell.Offset(0, 5) 
Dim startref As Variant 
startref = "I" & ActiveCell.Row 
Dim rownumber As Integer 
rownumber = ActiveCell.Row 

    ActiveCell.EntireRow.Select 
    Selection.Copy 
    Sheets("Result").Select 
    Rows(hierarchy).Select 
    ActiveSheet.Paste 

Sheets("Main Tree").Select 
Range(startref).Select 
For i = rownumber To 2 Step -1 
    If cells(i - 1, 9).Value - 1 = cells(i, 9).Value And cells(i - 1, 3).Value = "Group" Then 
     Rows(i).Select 
     Selection.Copy 
     Sheets("Result").Select 
     Rows(hierarchy - 1).Select 
     ActiveSheet.Paste 
    End If 
Next i 

End Sub 

Répondre

0

Cette traverse la hiérarchie en arrière dans « Résultats » qui est une copie complète de feuille « Tableau de bord »

  • CUIRS toutes les lignes, unhides puis chaque ligne concernée, afin d'éviter les données de copier et coller

Option Explicit 

Public Sub ShowHierarchy() 
    Dim ws As Worksheet, found As Range, r As Long, nextR As Long 

    Set ws = ThisWorkbook.Worksheets("Results") 
    Set found = ws.UsedRange.Columns(2).Find(What:="ABC10", LookAt:=xlWhole) 
    If Not found Is Nothing Then    'ABC100 was found so we continue 
     ws.UsedRange.EntireRow.Hidden = True 'hide all rows on Results sheet 
     r = found.Row: nextR = -1    'get found row, and move up to next row 
     If r > 1 Then       'make sure it wasn't found on row 1 
      ws.Rows(1).Hidden = False   'unhide header row 
      ws.Cells(1).Activate    'update display (scroll to top row) 
      found.EntireRow.Hidden = False  'unhide found row 
      Dim foundLvl As Long, nextLvl As Long, lvlRng As Range 
      foundLvl = Val(found.Offset(0, 2)) 'get current level from column D 
      nextLvl = foundLvl     'establish initial (minimum) level 
      Application.ScreenUpdating = False 'turn off display 
      While nextLvl > 1     'loop while level is greater than 1 
       Set lvlRng = found.Offset(nextR, 2) 'get next level from column D 
       If Not IsError(lvlRng) Then  'check for errors (#N/A, #DIV/0!, etc) 
        nextLvl = Val(lvlRng)  'set next level 
        If nextLvl < foundLvl Then 'compare levels 
         If LCase(lvlRng.Offset(0, -3)) = "group" Then 'check Group in Col A 
          foundLvl = nextLvl 'set next minimum levele 
          lvlRng.EntireRow.Hidden = False 
         End If 
        End If 
       End If 
       nextR = nextR - 1    'move up to the next row, and repeat 
      Wend 
      Application.ScreenUpdating = True 'turn display back on 
     End If 
    End If 
End Sub 

Avant

Before

Après

After

+0

Merci beaucoup Paul pour la solution. Je suppose que le résultat final est le même dans ce cas. Je vais essayer de mettre en œuvre les codes et de voir si cela résout mon problème. – Jay

+0

Salut Paul, j'ai testé le code et malheureusement cela n'a pas fonctionné comme prévu. Je pense que ce qui a mal tourné, c'est la façon dont le code définit le «groupe». Vous pouvez voir dans mon fichier d'origine que s'il s'agit d'un code de compte (ABC100) dans la colonne B, la colonne A affichera "Compte" au lieu de "Groupe", ce qui est le cas dans votre capture d'écran. Quand je lance la macro, elle affiche uniquement la ligne d'en-tête et la ligne 'find'. De plus, la fonction 'find' ne se base pas sur la correspondance de la valeur entière de la cellule, donc si je devais trouver "ABC10" par exemple, le compte "ABC109" apparaîtrait s'il se trouvait au-dessus de "ABC10". Merci! Jay – Jay

+0

J'ai fait les changements que vous avez mentionnés: il vérifie le mot "Group" dans la colonne A, et la fonction 'Find' regarde la valeur entière de la cellule - si vous recherchez" ABC10 "il ne retournera pas la valeur" ABC109 " –

0

Tenir compte pas de boucle For ou If logique et il suffit d'utiliser SQL que vous pouvez dans Excel pour PC en utilisant les Jet/ACE SQL Engine (fichiers .dll de Windows). Parce que votre feuille de calcul représente une table que nous pouvons exécuter différentes logiques WHERE à la sortie de résultats onglet avec la méthode CopyFromRecordset:

SQL(embedded ci-dessous, réglez SheetName et en-têtes de colonnes au besoin)

SELECT [Type], [Account/Group ID], [Account/Group Name], [Hierarchy Position] 
FROM SheetName$ 
WHERE (([Type] = 'Group' AND [Account/Group Name] NOT LIKE '%dupe%') 
     OR ([Account/Group ID] = 'ABC100')) 
    AND ([Hierarchy Position] <= (SELECT Max([Hierarchy Position]) 
           FROM SheetName$ sub 
           WHERE sub.[Account/Group ID] = 'ABC100')) 

VBA(se connecte à dernière instance enregistrée du classeur en cours)

Sub RunSQL() 
    Dim conn As Object, rs As Object 
    Dim strConnection As String, strSQL As String 
    Dim i As Integer 

    Set conn = CreateObject("ADODB.Connection") 
    Set rs = CreateObject("ADODB.Recordset") 

    ' CONNECTION STRINGS (TWO VERSIONS -ODBC/OLEDB) 
    strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _ 
         & "DBQ=C:\Path\To\Workbook.xlsm;" 
' strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _ 
'      & "Data Source=C:\Path\To\Workbook.xlsm';" _ 
'      & "Extended Properties=""Excel 12.0 Xml;HDR=YES;"";" 

    ' OPEN DB CONNECTION 
    conn.Open strConnection 

    strSQL = "SELECT [Type], [Account/Group ID], [Account/Group Name], [Hierarchy Position]" _ 
       & " FROM SheetName$" _ 
       & " WHERE (([Type] = 'Group' AND [Account/Group Name] NOT LIKE '%dupe%')" _ 
       & "  OR ([Account/Group ID] = 'ABC100'))" _ 
       & " AND ([Hierarchy Position] <= (SELECT Max([Hierarchy Position])" _ 
       & "         FROM SheetName$ sub" _ 
       & "         WHERE sub.[Account/Group ID] = 'ABC100'))" 

    ' OPEN RECORDSET OF SQL RESULTS 
    rs.Open strSQL, conn 

    ' OUTPUT DATA TO EXISTING SHEET 
    With ThisWorkbook.Worksheets("results") 
      ' COLUMN HEADERS 
      For i = 1 To rs.Fields.Count 
       .Cells(1, i) = rs.Fields(i - 1).Name 
      Next i  

      ' DATA ROWS 
      .Range("A2").CopyFromRecordset rs 
    End With 

    rs.Close: conn.Close 
    Set rs = Nothing: Set conn = Nothing 
    Exit Sub 

End Sub 
+0

Salut Parfait, c'est très compliqué alors j'ai anticipé et je pense que je vais devoir passer encore 30 heures de recherche aussi pour SQL :) Appréciez vraiment votre aide, une chose que j'ai remarquée dans votre SQL, une des règles de correspondance semble être nom ne pas avoir "dupe" en elle. Mon exemple est vraiment juste pour illustrer la hiérarchie des données et donc le nom du compte/groupe ne reflète pas l'ensemble de données réel. Les noms de compte/groupe dans un ensemble de données réel peuvent être n'importe quoi et ne suivent pas un modèle particulier ou ne contiennent pas certains mots. Cela étant dit, le SQL fonctionnerait-il encore? À votre santé. Jay – Jay

+0

Je pense que cela peut fonctionner pour vos besoins si * Type * sera toujours * Groupe * et * Compte *. Excepté pour le * dupe * et la recherche sur * ABC100 *, aucun endroit ne demande de coder en dur les noms. Essayez-le et voyez.Si c'est trop complexe, peut-être que les futurs lecteurs trouveront une utilité. – Parfait

+0

Merci, Parfait! – Jay

0

Essayez ceci. Cela a utilisé un tableau variant.

Sub test() 
    Dim vDB, vR() 
    Dim Ws As Worksheet, toWs As Worksheet 
    Dim r As Long, i As Long, n As Long, j As Integer 
    Set Ws = ActiveSheet 
    Set toWs = Sheets(2) 

    vDB = Ws.Range("a1").CurrentRegion 
    r = UBound(vDB, 1) 
    For i = 2 To r 
     If InStr(vDB(i, 3), "Group Level") Or vDB(i, 1) = "ABC100" Then 
      n = n + 1 
      ReDim Preserve vR(1 To 4, 1 To n) 
      For j = 1 To 4 
       vR(j, n) = vDB(i, j) 
      Next j 
     End If 
    Next i 
    With toWs 
     .UsedRange.Clear 
     .Range("a1").Resize(1, 4) = Ws.Range("a1").Resize(1, 4).Value 
     .Range("a2").Resize(n, 4) = WorksheetFunction.Transpose(vR) 
     .Columns.AutoFit 
    End With 

End Sub