VBA EXCEL FIND valeur, puis la somme, puis supprimez autre rangée

Question

enter image description here [enter image description ici] [2] Salut,

J'ai un problème et nous espérons que quelqu'un peut aider. J'ai une feuille Excel et je dois vérifier si partant de la dernière ligne si la même valeur que dans la colonne 4 de la dernière rangée existe quelque part dessus, mais la condition est que seulement si la colonne 1 et la colonne 2 sont identiques et non dans la colonne 3 le mot "SK" ou "SV" et ensuite je dois additionner les valeurs dans la colonne 7 et concaterner la colonne 3 et la colonne 6 et juste garder une ligne et l'autre qui étaient la base de ce calcul doit être supprimé.

En pièce jointe, vous trouverez les captures d'écran. D'abord, à quoi ressemble le fichier Excel avant le traitement et la capture d'écran suivante, à quoi cela devrait ressembler après.

enter image description here

Answer 1

Voici le code:

Sub combine_data() 

    Dim vLastRow As Integer 
    Dim Col_A_Str As String 
    Dim Col_B_Str As String 
    Dim r As Integer 
    Dim vDatarow As Integer 
    Dim vCodeStr3 As String 
    Dim vCodeStr6 As String 
    Dim vTotal As Double 
    Dim Col_D_Str As String 

    vLastRow = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row 
    Col_A_Str = "" 
    Col_B_Str = "" 
    r = 1 
    vDatarow = 0 
    vCodeStr3 = "" 
    vCodeStr6 = "" 
    vTotal = 0 
    Col_D_Str = "" 

    Col_A_Str = Trim(Cells(vLastRow, 1)) 
    Col_B_Str = Trim(Cells(vLastRow, 2)) 
    Col_D_Str = Trim(Cells(vLastRow, 4)) 

    Do Until r = vLastRow 

     DoEvents 

     If Trim(Cells(r, 4)) = Col_D_Str Then 

      If Trim(Cells(r, 1)) = Col_A_Str Then 

       If Trim(Cells(r, 2)) = Col_B_Str Then 

        If UCase(Trim(Cells(r, 3))) <> "SV" And UCase(Trim(Cells(r, 3))) <> "SK" Then 

         If vDatarow = 0 Then 

          If vDatarow = 0 Then vDatarow = r 

          vCodeStr3 = Trim(Cells(r, 3)) 
          vCodeStr6 = Trim(Cells(r, 6)) 
          vTotal = Cells(r, 7) 

          r = r + 1 

         Else 

          vCodeStr3 = vCodeStr3 & ", " & Trim(Cells(r, 3)) 
          vCodeStr6 = vCodeStr6 & ", " & Trim(Cells(r, 6)) 
          vTotal = vTotal + Cells(r, 7) 

          Cells(r, 1).EntireRow.Delete 
          vLastRow = vLastRow - 1 

         End If 

        Else 

         r = r + 1 

        End If 

       Else 

        r = r + 1 

       End If 

      Else 

       r = r + 1 

      End If 

     Else 

      r = r + 1 

     End If 

    Loop 

    Cells(vDatarow, 3).ClearContents 
    Cells(vDatarow, 3) = vCodeStr3 

    Cells(vDatarow, 6).ClearContents 
    Cells(vDatarow, 6) = vCodeStr6 

    Cells(vDatarow, 7).ClearContents 
    Cells(vDatarow, 7) = vTotal 

End Sub