VBA Comparer 2 cellules sur 2 feuilles differentes

[Johanes]

Bonjour,

Je voudrais creer une macro a l'interieur d'un fichier excel.

J'ai une feuille General avec des numeros de chambre et le recapitulatif des bouteilles d'eau et de champagne.
J'ai une feuille Champagne avec les numeros de chambre ou je dois envoyer une bouteille de champagne par chambre.
J'ai une feuille water avec les numeros de chambre en colonne B et en colonne A le nombre de bouteille d'eau a envoyer par chambre.

Je voudrai tout d'abord comparer les chambres dans la feuille champagne et dans la feuille General: En surlignant les numeros de chambre dans la feuille general et a la fin de la ligne mettre le total de chambre surligner.

Et ensuite je voudrais reporter le nombre de bouteille d'eau dans la feuille water sur la feuille general. Sauf que dans la feuille water j'ai les bouteilles d'eau en A1 pour la chambre qui est B1. et sur la feuille general si la chambre correspondante est en G12 je dois inscrire le nombre de bouteille d'eau en G11.

si possible creer un bouton pour executer la macro en page General et non pas faire ALT+F8

Ci-joint Fichier que j'ai rempli manuellement.

 

[klin89]

Bonsoir à tous,

Avec le fichier du post #9
il faur préalablament exécuter la macro Initialiser de vgendron pour le nettoyage des cellules de la feuille "GENERAL"

Option Explicit
Sub test()
Dim a, i As Long, j As Long, w(), dico As Object, txt As String
    Set dico = CreateObject("Scripting.Dictionary")
    a = Sheets("Champagne").Range("a1").CurrentRegion.Value
    For i = 2 To UBound(a, 1) - 1
        dico.Item(a(i, 2)) = VBA.Array(True, Empty)
    Next
    a = Sheets("water").Range("a1").CurrentRegion.Value
    For i = 2 To UBound(a, 1) - 1
        If dico.exists(a(i, 2)) Then
            w = dico.Item(a(i, 2))
            w(1) = a(i, 1)
            dico.Item(a(i, 2)) = w
        Else
            dico.Item(a(i, 2)) = VBA.Array(False, a(i, 1))
        End If
    Next
    Application.ScreenUpdating = False
    'Initialiser
    With Sheets("GENERAL").Range("L10:AA" & Range("L" & Rows.Count).End(xlUp).Row)
        a = .Value
        For i = 1 To UBound(a, 1) Step 2
            For j = 1 To UBound(a, 2)
                txt = CStr(a(i + 1, j))
                If dico.exists(txt) Then
                    If dico.Item(txt)(0) = True Then
                        .Cells(i + 1, j).Interior.ColorIndex = 15
                    End If
                    If Not IsEmpty(dico.Item(txt)(1)) Then
                        .Cells(i, j).Value = dico.Item(txt)(1)
                    End If
                End If
            Next
        Next
    End With
    Application.ScreenUpdating = True
End Sub

klin89

 

[Johanes]

klin89 Le problem a ete resolu. Pouvez vous regarder mon post #14.
C est un petit peu plus compliquer...