Problème avec code pour trouvé le nombre d'occurrences

Résolu/Fermé
bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 - 11 mai 2016 à 20:29
bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 - 24 mai 2016 à 16:30
Bonjour,

J'essais de créer un code pour détecter le nombre de colonne correspondant au texte "Sensor Reading" dans l'entête de mes colonnes situé en ligne 1, à partir de la colonne F jusqu'à la dernière colonne.

Je utiliser se nombre afin de pouvoir contrôler le nombre de graphique à faire afficher sur mes feuilles. Le nombre d'occurrence sera appelé "NbrPiezo"

Après plusieurs essais, ça ne fonctionne toujours pas! J'ai une erreur 438 sur la ligne
Rows(1).Find("Sensor Reading", Cells(1, i), xlValues).Column


Voici mon code complet:
Option Explicit
Public CollectBT As Collection
Private Tx As MSForms.TextBox

Private Sub CommandButton1_Click()

Dim DerCol As Integer, PremDercol As Integer, DerLig As Integer, NoCol As Integer, Nbre As Byte, Cptr As Byte, col As Integer, activesheets As Range
Dim i As Integer, fichier As String, nom As String, rep As String, v As Integer, NCol As Integer
Dim recherche As String, Compteur As Integer, Nbrpiezo As Integer

If TextBox1.Text = "" Then
    MsgBox "Vous devez entrer un nom de Site!", vbOKOnly + vbCritical, "ERREUR SITE!"
ElseIf TextBox2.Text = "" Then
    MsgBox "Vous devez entrer un nom de Sondage!", vbOKOnly + vbCritical, "ERREUR SONDAGE!"
Else
    
End If

Application.ScreenUpdating = False

Call mOuvrir.Choisir_fichier("en.dat")

UserForm2.Hide

With ActiveSheet
PremDercol = .Cells(2, .Cells.Columns.Count).End(xlToLeft).Column
    With .Range(Cells(1, 1), Cells(1, PremDercol))
        For i = 24 To 12 Step -1
            If Mid((Cells(1, i)), 16, 2) = "kg" Then
                Columns(i).Delete
            End If
        Next i
        For i = PremDercol To 21 Step -1
            If Mid((Cells(1, i)), 19, 7) = "Channel" Then
                Columns(i).Delete
            End If
        Next i
    End With
    
DerCol = .Cells(2, .Cells.Columns.Count).End(xlToLeft).Column
DerLig = .Range("A" & Rows.Count).End(xlUp).Row

    .Columns("A").ColumnWidth = 13
    .Columns("G:H").ColumnWidth = 10
    .Cells.VerticalAlignment = xlVAlignCenter
    .Cells.HorizontalAlignment = xlHAlignCenter
    
     For i = 2 To DerLig Step 2
        .Range(Cells(i, 1), Cells(i, DerCol)).Interior.ColorIndex = 15
    Next i

    With .Range(Cells(1, 1), Cells(DerLig, DerCol))
        .Borders.Weight = xlThin
        .Rows(1).Borders(xlEdgeBottom).LineStyle = xlDouble
        .Rows(1).RowHeight = 33
        .Rows(1).WrapText = True
        .BorderAround ColorIndex:=1, Weight:=xlMedium
    End With
   
   .Columns("E").Insert shift:=xlRight
   .Columns("E").ColumnWidth = 10
   .Range("E1").Value = "jours-mois"
    
    With .Columns("E")
        For v = 2 To DerLig
            Columns.Cells(v, 5).Value = Cells(v, 3).Value & "-" & Cells(v, 4).Value
        Next
    End With
    
    .Range("C:D").EntireColumn.Hidden = True
    
     Nbre = Application.CountIf(Rows(1), "Sensor*")
        If Nbre > 0 Then
            col = .Cells.Columns.Count
                For Cptr = 1 To Nbre
                    col = .Rows(1).Find("Sensor Temp", Cells(1, col), xlValues).Column
                    With .Cells(1, col)
                        .Interior.ColorIndex = 37
                        .ColumnWidth = 15
                    End With
                        If Cptr = 1 Then
                        .Range(Cells(1, col), Cells(DerLig, col)).Borders(xlEdgeLeft).Weight = xlMedium
                        End If
                Next
                For Cptr = 1 To Nbre
                col = .Rows(1).Find("Sensor Reading", Cells(1, col), xlValues).Column
                    With .Cells(1, col)
                        .Interior.ColorIndex = 36
                        .ColumnWidth = 20
                    End With
                Next
        End If
    
    .Range(Cells(1, 5), Cells(DerLig, 5)).Borders(xlEdgeRight).Weight = xlMedium
    .Range(Cells(1, 2), Cells(DerLig, 2)).Borders(xlEdgeLeft).Weight = xlMedium
    .Range(Cells(1, 10), Cells(DerLig, 10)).Borders(xlEdgeRight).Weight = xlMedium
    .Range(Cells(1, 8), Cells(DerLig, 8)).Borders(xlEdgeRight).Weight = xlMedium
    .Columns("F").ColumnWidth = 10
End With

With Sheets(1).Range(Cells(1, 6), Cells(1, DerCol))
    For i = 6 To DerCol
        Rows(1).Find("Sensor Reading", Cells(1, i), xlValues).Column
        Compteur = Compteur + 1
    Next i
Nbrpiezo = Compteur
End With

Sheets.Add.Move after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Graphique"
Call zone_texte
 
If Nbrpiezo <= 3 Then
     Call graphique
     Exit Sub
End If

    Sheets.Add.Move after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Graphique2"
    Call zone_texte

If Nbrpiezo <= 6 Then
     Call graphique
     Exit Sub
End If

    Sheets.Add.Move after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Graphique3"
    Call zone_texte
    Call graphique


'Sheets(1).Select


Application.Visible = True

            With ActiveWorkbook
                Application.DisplayAlerts = False
                If MsgBox("Voulez-vous sauvegarder ce fichier en .xlsx?", vbOKCancel + vbQuestion, "SAUVEGARDE") = vbCancel Then
                        Application.ThisWorkbook.Saved = True
                        ActiveWorkbook.Close
                        Exit Sub
                    Else
                        fichier = UserForm2.TextBox1
                        nom = fichier & "_" & Format(Date, "yyyy-mm-dd") & "_" & ".xls"
                        .SaveAs ActiveWorkbook.Path & "\" & nom, FileFormat:=xlNormal, CreateBackup:=False
                        rep = MsgBox("Votre fichier est sauvegardée sous le nom : " & nom, vbOKOnly + vbInformation, "Copie sauvegarde classeur")
                    End If
                Application.DisplayAlerts = True
            End With

Application.ThisWorkbook.Saved = True
Application.ScreenUpdating = True
'ActiveWorkbook.Close
'Application.Quit


End Sub


Merci pour votre aide!

2 réponses

ccm81 Messages postés 10854 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 26 avril 2024 2 404
Modifié par ccm81 le 11/05/2016 à 21:57
Bonjour

détecter le nombre de colonne correspondant au texte "Sensor Reading" dans l'entête de mes colonnes situé en ligne 1, à partir de la colonne F jusqu'à la dernière colonne. de la feuille f
cofin = f.Cells(1, Columns.Count).End(xlToLeft).Column
Set plage = f.Range(Cells(1, codeb), Cells(1, cofin))
nbgr = Application.WorksheetFunction.CountIf(plage, "Sensor Reading")


Cdlmnt
1
bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 1
16 mai 2016 à 16:58
Merci pour la réponse!!

Mais je ne comprend très bien ce que je doit faire. est-ce que je suprime toute la partie du code:
With Sheets(1).Range(Cells(1, 6), Cells(1, DerCol))
    For i = 6 To DerCol
        Rows(1).Find("Sensor Reading", Cells(1, i), xlValues).Column
        Compteur = Compteur + 1
    Next i
Nbrpiezo = Compteur
End With
et les remplace par les trois lignes proposées?

J'ai essayé ça
With Sheets(1)
    colfin = .Cells(1, Columns.Count).End(xlToLeft).Column
    
    For i = 6 To colfin
        Set Plage = .Range(Cells(1, 6), Cells(1, colfin))
        nbgr = Application.WorksheetFunction.CountIf(Plage, "Sensor Reading")
        'If Not nbgr Is Nothing Then
        Compteur = Compteur + 1
    Next i
Nbrpiezo = Compteur
End With
mais ça ne fonctionne pas, le compteur est toujours à 0 à la fin.
0
ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160
12 mai 2016 à 09:33
Bonjour le fil, bonjour le forum,

Tout à fait d'accord avec CCM81, c'est la bonne méthode !...

J'imagine que tu parles du code des lignes 104 à 110 (sur CCM). Ta méthode, plus extravagante, aurait pu fonctionner comme ça :

For i = 6 To DerCol
    Set R = Cells(1, i).Find("Sensor Reading", , xlValues, xlWhole)
    If Not R Is Nothing Then Compteur = Compteur + 1
Next i
Nbrpiezo = Compteur


Mais tu avais trois erreurs :
- La méthode Find renvoie une variable de type Range ou une valeur numérique associée à .Row ou .Column à la fin. Sans lui associer une variable elle plante. Tu aurais dû écrire (ligne 106), comme tu l'as fait (ligne 89) Col = ...
- Ensuite,en imaginant que tu aies écrit Col = , si tu recherches dans la ligne entière et même si tu décales la cellule de départ, Col renverra toujours la colonne de la première occurrence trouvée.
- Pour finir, sans condition If... End If, ton compteur sera toujours incrémenté...

--
À plus,
ThauTheme
0
bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 1
16 mai 2016 à 21:29
Merci pour la réponse ThauTheme!

J'ai essayé ton code , je n'ai pas de message d'erreur, mais mon compteur est toujours à 0 alors qu'il y a 6 colonne avec "Sensor Reading".

Est-ce que c'est parce que dans la cellule il n'y a pas seulement ces 2 mots? Dans ma cellule il est écrit "Sensor Reading(KPa) - 1528243 - 18m".

J'ai changer xlwhole pour xlpart, mais ça ne change rien!

Merci!
0
ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160 > bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023
17 mai 2016 à 10:23
Bonjour le fil, bonjour le forum,

Pourquoi t'acharner sur cette méthode qui n'est pas la meilleure. J'ai juste voulu te montrer pourquoi ça ne marchait pas... Utilise plutôt la méthode proposée par CCM.

Sinon, sans fichier pour tester, je ne peux pas t'expliquer pourquoi ça ne fonctionne pas même avec XlPart...
0
bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 1 > ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022
17 mai 2016 à 19:50
Bonjour,

Ce que j'ai essayé la proposition de CCM81 et ça ne fonctionne pas non plus. Voici ce que j'ai fait:
.Range(Cells(1, 5), Cells(DerLig, 5)).Borders(xlEdgeRight).Weight = xlMedium
    .Range(Cells(1, 2), Cells(DerLig, 2)).Borders(xlEdgeLeft).Weight = xlMedium
    .Range(Cells(1, 10), Cells(DerLig, 10)).Borders(xlEdgeRight).Weight = xlMedium
    .Range(Cells(1, 8), Cells(DerLig, 8)).Borders(xlEdgeRight).Weight = xlMedium
    .Columns("F").ColumnWidth = 10
End With


ColFin = Sheets(1).Cells(1, Columns.Count).End(xlToLeft).Column
Set plage = Sheets(1).Range(Cells(1, 6), Cells(1, ColFin))
Nbgr = Application.WorksheetFunction.CountIf(plage, "Sensor Reading")

Nbrpiezo = Nbgr
MsgBox Nbrpiezo


Sheets.Add.Move after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Graphique"
Call zone_texte
 
If Nbrpiezo <= 3 Then
     Call graphique
     Exit Sub
End If

    Sheets.Add.Move after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Graphique2"
    Call zone_texte

If Nbrpiezo <= 6 Then
     Call graphique
     Exit Sub
End If

    Sheets.Add.Move after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Graphique3"
    Call zone_texte
    Call graphique

Application.Visible = True

            With ActiveWorkbook
                Application.DisplayAlerts = False
                If MsgBox("Voulez-vous sauvegarder ce fichier en .xlsx?", vbOKCancel + vbQuestion, "SAUVEGARDE") = vbCancel Then
                        Application.ThisWorkbook.Saved = True
                        ActiveWorkbook.Close
                        Exit Sub
                    Else
                        fichier = UserForm2.TextBox1
                        nom = fichier & "_" & Format(Date, "yyyy-mm-dd") & "_" & ".xls"
                        .SaveAs ActiveWorkbook.Path & "\" & nom, FileFormat:=xlNormal, CreateBackup:=False
                        rep = MsgBox("Votre fichier est sauvegardée sous le nom : " & nom, vbOKOnly + vbInformation, "Copie sauvegarde classeur")
                    End If
                Application.DisplayAlerts = True
            End With

Application.ThisWorkbook.Saved = True
Application.ScreenUpdating = True

End Sub


Quand j'utilise le pas à pas avec un espion sur la valeur de Nbgr, elle est toujours égale à zéro. Est-ce que c'est parce que dans ma cellule les mots recherchés font partie d'une série de chiffre et de lettre?

Merci pour votre aide!
0
ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022 160 > bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023
18 mai 2016 à 11:32
Bonjour le fil, bonjour le forum,

Essaie comme ça :

Nbgr = Application.WorksheetFunction.CountIf(plage, "*Sensor Reading*")
0
bassmart Messages postés 281 Date d'inscription jeudi 19 février 2015 Statut Membre Dernière intervention 19 décembre 2023 1 > ThauTheme Messages postés 1442 Date d'inscription mardi 21 octobre 2014 Statut Membre Dernière intervention 29 juillet 2022
24 mai 2016 à 16:30
Merci pour la réponse ThauTheme!

Ça fonctionne très bien de cette façon!

Encore merci!
0