VBA Excel Remplissage des cellules basé sur l'existence précédente

Question

Je n'ai pas encore vu cela, mais je pense que c'est peut-être parce que je ne sais pas comment exprimer mon problème de façon concise. Voici un exemple de ce que je voudrais essayer:

Étant donné une colonne qui contient des initiales d'état, vérifiez la feuille de sortie si cet état a déjà été trouvé. Si ce n'est pas le cas, remplissez une nouvelle cellule avec les initiales de cet état et initialisez le nombre (nombre de fois où l'état a été trouvé) à un. Si les initiales de l'état sont trouvées dans une cellule de la feuille de sortie, incrémentez le compte d'une unité. Avec ceci, si nous avons une feuille d'Excel doublée de 50 000 (ou plusieurs) qui a des états dans un ordre aléatoire (les états peuvent être répétés ou pas) nous pourrons créer une table propre qui produira les états qui sont dans la fiche de données brute et combien de fois ils sont apparus. Une autre façon d'y penser est de coder un tableau croisé dynamique, mais avec moins d'informations.

Il y a plusieurs façons que j'ai pensé à la façon de compléter cela, je pense personnellement qu'aucun d'entre eux sont de très bonnes idées mais nous verrons.

algorithme 1, les 50 états:

1. création de 50 variables de chaîne pour chaque état, créer 50 variables longues pour les comptes
2. boucle par feuille de données brutes, si l'état spécifique trouvé alors incrémenter le nombre approprié (cela nécessiterait 50 si-ELSE)
3. résultats de sortie

Dans l'ensemble ..... idée terrible

algorithme 2, la bascule:

1. Ne créez pas des variables
2. Si un état se trouve dans la feuille de données brutes, consultez la feuille de sortie pour vérifier si l'état a été trouvé avant
3. Si l'état a été trouvé avant, incrémenter cellule adjacente par un
4. Si l'état n'a pas été trouvé avant, changer de cellule disponible suivant vide pour indiquer les initiales et initialiser cellule adjacente à une
5. Retour à la fiche de données brutes

Dans l'ensemble ... cela pourrait fonctionner, mais j'ai l'impression que cela prendrait une éternité, même avec des feuilles de données brutes qui ne sont pas très grandes mais qui ont l'avantage de ne pas gaspiller de mémoire En bas des lignes de code

Sur une note de côté, est-il possible d'accéder aux cellules d'un classeur (ou feuille de calcul) sans activer ce classeur? Je demande parce que cela rendrait le deuxième algorithme beaucoup plus rapide.

Merci,

Jesse Smothermon

Answer 1

Un couple de points qui permettra d'accélérer votre code:

1. Vous n'avez pas besoin de classeurs actifs, des feuilles de calcul ou gammes pour y accéder par exemple

   DIM wb as workbook 
   DIM ws as worksheet 
   DIM rng as range 
   
   Set wb = Workbooks.OpenText(Filename:=filePath, Tab:=True) ' or Workbooks("BookName") 
   Set ws = wb.Sheets("SheetName") 
   Set rng = ws.UsedRange ' or ws.[A1:B2], or many other ways of specifying a range 
   

Vous pouvez maintenant vous référer au classeur/feuille/gamme comme

rng.copy 
for each cl in rng.cells 
etc 

1. Looping par les cellules est très lente. Beaucoup plus rapide de copier les données dans un tableau de variantes en premier, puis de faire une boucle dans le tableau. De même, lors de la création d'une grande quantité de données sur une feuille, il est préférable de la créer dans un tableau de variantes, puis de la copier dans la feuille en une fois.

   DIM v As Variant 
   v = rng 
   

par exemple si RNG fait référence à une gamme de 10 lignes par 5 colonnes, v devient un tableau de faible 1 à 10, 1 à 5. Les 5 minutes que vous mentionnez serait probablement réduit à quelques secondes au plus

Answer 2

Je mon deuxième algorithme mis en œuvre pour voir comment il fonctionnerait. Le code est ci-dessous, j'ai laissé de petits détails dans le problème réel pour essayer d'être plus clair et arriver au problème de base, désolé à ce sujet. Avec le code ci-dessous, j'ai ajouté les autres "parties".

code:

' this number refers to the raw data sheet that has just been activated 
totalRow = ActiveSheet.Range("A1").End(xlDown).Row 
    For iRow = 2 To totalRow 
     ' These are specific to the company needs, refers to addresses 
     If (ActiveSheet.Cells(iRow, 2) = "BA") Then 
      badAddress = badAddress + 1 
     ElseIf (ActiveSheet.Cells(iRow, 2) = "C") Then 
      coverageNoListing = coverageNoListing + 1 
     ElseIf (ActiveSheet.Cells(iRow, 2) = "L") Then 
      activeListing = activeListing + 1 
     ElseIf (ActiveSheet.Cells(iRow, 2) = "NC") Then 
      noCoverageNoListing = noCoverageNoListing + 1 
     ElseIf (ActiveSheet.Cells(iRow, 2) = "NL") Then 
      inactiveListing = inactiveListing + 1 
     ElseIf (ActiveSheet.Cells(iRow, 2) = "") Then 
      noHit = noHit + 1 
     End If 
     ' Algorithm beginning 
     ' If the current cell (in state column) has something in it 
     If (ActiveSheet.Cells(iRow, 10) <> "") Then 
      ' Save value into a string variable 
      tempState = ActiveSheet.Cells(iRow, 10) 
      ' If this is also in a billable address make variable true 
      If (ActiveSheet.Cells(iRow, 2) = "C") Or (ActiveSheet.Cells(iRow, 2) = "L") Or (ActiveSheet.Cells(iRow, 2) = "NL") Then 
       boolStateBillable = True 
      End If 
      ' Output sheet 
      BillableWorkbook.Activate 
      For tRow = 2 To endOfState 
       ' If the current cell is the state 
       If (ActiveSheet.Cells(tRow, 9) = tempState) Then 
        ' Get the current hit count of that state 
        tempStateTotal = ActiveSheet.Cells(tRow, 12) 
        ' Increment the hit count by one 
        ActiveSheet.Cells(tRow, 12) = tempStateTotal + 1 
        ' If the address was billable then increment billable count 
        If (boolStateBillable = True) Then 
         tempStateBillable = ActiveSheet.Cells(tRow, 11) 
         ActiveSheet.Cells(tRow, 11) = tempStateBillable + 1 
        End If 
        Exit For 
       ' If the tempState is unique to the column 
       ElseIf (tRow = endOfState) Then 
        ' Set state, totalCount 
        ActiveSheet.Cells(tRow - 1, 9) = tempState 
        ActiveSheet.Cells(tRow - 1, 12) = 1 
        ' Increment the ending point of the column 
        endOfState = endOfState + 1 
        ' If it's billable, indicate with number 
        If (boolStateBillable = True) Then 
         tempStateBillable = ActiveSheet.Cells(tRow - 1, 11) 
         ActiveSheet.Cells(tRow - 1, 11) = tempStateBillable + 1 
        End If 
       End If 
      Next 
     ' Activate raw data workbook 
     TextFileWorkbook.Activate 
     ' reset boolean 
     boolStateBillable = False 
    Next 

je l'ai couru une fois et il semble avoir travaillé. Le problème est qu'il a fallu environ cinq minutes ou plus, le code original prend 0.2 (approximation approximative). Je pense que la seule façon de rendre le code plus rapide est de ne pas pouvoir activer les deux classeurs encore et encore. Cela signifie que la réponse n'est pas complète, mais je vais modifier si je trouve le reste.

Note Je vais revoir les tableaux croisés dynamiques pour voir si je peux faire tout ce dont j'ai besoin pour eux, à partir de maintenant, il semble qu'il y ait quelques choses que je ne pourrai pas changer mais vérifierons

Merci,

Jesse Smothermon

Answer 3

Sub CountStates() 
    Dim shtRaw As Excel.Worksheet 
    Dim r As Long, nr As Long 
    Dim dict As Object 
    Dim vals, t, k 

    Set dict = CreateObject("scripting.dictionary") 
    Set shtRaw = ThisWorkbook.Sheets("Raw") 
    vals = Range(shtRaw.Range("C2"), _ 
       shtRaw.Cells(shtRaw.Rows.Count, "C").End(xlUp)).Value 
    nr = UBound(vals, 1) 

    For r = 1 To nr 
     t = Trim(vals(r, 1)) 
     If Len(t) = 0 Then t = "Empty" 
     dict(t) = dict(t) + 1 
    Next r 

    For Each k In dict.keys 
     Debug.Print k, dict(k) 
    Next k 
End Sub 

Answer 4

Je continuais avec le deuxième algorithme. Il y a l'option de dictionnaire que j'ai oubliée mais je ne suis toujours pas très à l'aise avec son fonctionnement et je ne la comprends pas encore tout à fait. J'ai joué un peu avec le code et j'ai changé quelque chose, ça marche maintenant plus vite.

code:

' In output workbook (separate sheet) 
Sheets.Add.Name = "Temp_Text_File" 

' Opens up raw data workbook (originally text file 
Application.DisplayAlerts = False 
Workbooks.OpenText Filename:=filePath, Tab:=True 
Application.DisplayAlerts = True 
Set TextFileWorkbook = ActiveWorkbook 
totalRow = ActiveSheet.Range("A1").End(xlDown).Row 
' Copy all contents of raw data workbook 
Cells.Select 
Selection.Copy 

BillableWorkbook.Activate 

' Paste raw data into "Temp_Text_File" sheet 
Range("A1").Select 
ActiveSheet.Paste 

ActiveWorkbook.Sheets("Billable_PDF").Select 

' Populate long variables 
For iRow = 2 To totalRow 
    If (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "BA") Then 
     badAddress = badAddress + 1 
    ElseIf (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "C") Then 
     coverageNoListing = coverageNoListing + 1 
    ElseIf (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "L") Then 
     activeListing = activeListing + 1 
    ElseIf (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "NC") Then 
     noCoverageNoListing = noCoverageNoListing + 1 
    ElseIf (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "NL") Then 
     inactiveListing = inactiveListing + 1 
    ElseIf (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "") Then 
     noHit = noHit + 1 
    End If 
    If (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 10) <> "") Then 
     tempState = ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 10) 
     If (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "C") Or (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "L") Or (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "NL") Then 
      boolStateBillable = True 
     End If 
     'BillableWorkbook.Activate 
     For tRow = 2 To endOfState 
      If (ActiveSheet.Cells(tRow, 9) = tempState) Then 
       tempStateTotal = ActiveSheet.Cells(tRow, 12) 
       ActiveSheet.Cells(tRow, 12) = tempStateTotal + 1 
       If (boolStateBillable = True) Then 
        tempStateBillable = ActiveSheet.Cells(tRow, 11) 
        ActiveSheet.Cells(tRow, 11) = tempStateBillable + 1 
       End If 
       Exit For 
      ElseIf (tRow = endOfState) Then 
       ActiveSheet.Cells(tRow, 9) = tempState 
       ActiveSheet.Cells(tRow, 12) = 1 
       endOfState = endOfState + 1 
       If (boolStateBillable = True) Then 
        tempStateBillable = ActiveSheet.Cells(tRow, 11) 
        ActiveSheet.Cells(tRow, 11) = tempStateBillable + 1 
       End If 
      End If 
     Next 
     'stateOneTotal = stateOneTotal + 1 
     'If (ActiveSheet.Cells(iRow, 2) = "C") Or (ActiveSheet.Cells(iRow, 2) = "L") Or (ActiveSheet.Cells(iRow, 2) = "NL") Then 
     ' stateOneBillable = stateOneBillable + 1 
     'End If 
    'ElseIf (ActiveSheet.Cells(iRow, 10) = "FL") Then 
     'stateTwoTotal = stateTwoTotal + 1 
     'If (ActiveSheet.Cells(iRow, 2) = "C") Or (ActiveSheet.Cells(iRow, 2) = "L") Or (ActiveSheet.Cells(iRow, 2) = "NL") Then 
     ' stateTwoBillable = stateTwoBillable + 1 
     'End If 
    End If 
    'TextFileWorkbook.Activate 
    If (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "C") Or (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "L") Or (ActiveWorkbook.Sheets("Temp_Text_File").Cells(iRow, 2) = "NL") Then 
     billableCount = billableCount + 1 
    End If 
    boolStateBillable = False 
Next 

' Close raw data workbook and raw data worksheet 
Application.DisplayAlerts = False 
TextFileWorkbook.Close 
ActiveWorkbook.Sheets("Temp_Text_File").Delete 
Application.DisplayAlerts = True 

Merci pour les commentaires et suggestions. C'est très apprécié comme toujours.

Jesse Smothermon