Discussion :

[aissaouiii]

Bonjour,

Comment faire pour calculer le nombre de redondances d'un chiffre donné dans une plage de cellules et de prendre le résultat pour le coller dans un autre classeur correspondant à la case du chiffre.
si j'étais pas clair ci-joint le lien pour deux classeurs types.

http://www.4shared.com/rar/TPeHdrFZ/...urs_1et_2.html

j'ai essayé de faire un code tout seul mais ça marche pas, je sais pas pourquoi.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Sub OfficeToTool()
 
Dim x As Byte, c As Variant
For c = 15 To 23
Workbooks("book1").Worksheets("sheet1").Activate
Set recherch = Workbooks("book1").Worksheets("Sheet1").Cells(c, 2)
x = Application.CountIf(Range("B15:B23"), recherch.Value)
DSGtoolOpen
If recherch.Value = 5 Then
'Workbooks("book2").Worksheets("sheet1")
 ActiveWorkbook.Worksheets("sheet1").Range("C15").Value = x
ElseIf recherch.Value = 7 Then
 ActiveWorkbook.Worksheets("sheet1").Range("C16").Value = x
ElseIf recherch.Value = 10 Then
ActiveWorkbook.Worksheets("sheet1").Range("C17").Value = x
ElseIf recherch.Value = 15 Then
ActiveWorkbook.Worksheets("sheet1").Range("C18").Value = x
ElseIf recherch.Value = 20 Then
ActiveWorkbook.Worksheets("sheet1").Range("C19").Value = x
ElseIf recherch.Value = 25 Then
ActiveWorkbook.Worksheets("sheet1").Range("C20").Value = x
ElseIf recherch.Value = 30 Then
ActiveWorkbook.Worksheets("sheet1").Range("C21").Value = x
ElseIf recherch.Value = 3 Then
ActiveWorkbook.Worksheets("sheet1").Range("C14").Value = x
End If
Next c
 
toolToVNS
 
End Sub
 
 
Sub toolOpen()
   On Error Resume Next
       Workbooks("book2").Activate
 
   If Err <> 0 Then
       Workbooks.Open ("C:\users\entreprise\desktop\book2")
 
   End If
 
End Sub
 
Sub toolToVNS()
 
Workbooks("book2").Worksheets("sheet1").Range("B32").Select
Selection.Copy
ThisWorkbook.Sheets("sheet1").Activate
Workbooks("book1").Worksheets("sheet1").Range("C34").Select
Selection.PasteSpecial Paste:=xlPasteValues
 
End Sub

Pourriez vous m'indiquer une autre solution ou me corriger le code ?

Merci d'avance pour vos réponses.

[QuestVba]

Bonjour,

Je n'ai pas vu ton fichier mais voici un code qui te permets de chercher le nombre de fois que la variable X apparaît dans la plage a1:d15

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
x = 4
y = Application.WorksheetFunction.CountIf(Range("a1:d15"), x)
MsgBox y

Pour la gestion des doublons une très bonne adresse

http://silkyroad.developpez.com/excel/doublons/

[gFZT82]

Bonjour,

Tu peux essayer comme cela (je n'ai pas ouvert tes classeurs).
Corrige les extensions fichiers si nécessaire.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Sub OfficeToTool()
Dim Recherch As Range
Dim x As Byte, C As Byte
Dim Ws1 As Workbook, Ws2 As Workbook
    toolOpen
    Set Ws1 = Workbooks("book1.xls")
    Set Ws2 = Workbooks("book2.xls")
    For C = 15 To 23
        With Ws1.Worksheets("sheet1")
            Set Recherch = .Cells(C, 2)
            x = Application.CountIf(.Range("B15:B23"), Recherch.Value)
        End With
        With Ws2.Worksheets("sheet1")
            If Recherch.Value = 3 Then
                .Range("C14").Value = x
            ElseIf Recherch.Value = 5 Then
                .Range("C15").Value = x
            ElseIf Recherch.Value = 7 Then
                .Range("C16").Value = x
            ElseIf Recherch.Value = 10 Then
                .Range("C17").Value = x
            ElseIf Recherch.Value = 15 Then
                .Range("C18").Value = x
            ElseIf Recherch.Value = 20 Then
                .Range("C19").Value = x
            ElseIf Recherch.Value = 25 Then
                .Range("C20").Value = x
            ElseIf Recherch.Value = 30 Then
                .Range("C21").Value = x
            End If
        End With
    Next C
    Ws2.Worksheets("sheet1").Range("B32").Copy
    Ws1.Worksheets("sheet1").Range("C34").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Set Recherch = Nothing
    Set Ws1 = Nothing
    Set Ws2 = Nothing
End Sub
Sub toolOpen()
    On Error Resume Next
    Workbooks("book2.xls").Activate
    If Err <> 0 Then
        Workbooks.Open ("C:\users\entreprise\desktop\book2.xls")
        On Error GoTo 0
    End If
End Sub

Cordialement.