probleme boucle VB code

[ridhaghanmi]

salut a tous,
j ai besoin de votre aide mes amis.
j ai un probleme avec mon code quand j ajoute une colonne entre C et D , la macro s arrete et donne pas le resultat volu. Voici le code et le fichier.

Private Sub cmdok_Click()

Dim x, y, z, temp, result, r_split, seat, myvalues, mycolours
Dim i As Long, k As Long, n As Long, offs As Long
Dim Gamedata As String

With Sheets(frmgame.cmbarea.Text)
    
    Application.ScreenUpdating = 0
    
    .Range("E2:EX300").Clear

    With Sheets("Gamedata")

        x = .Range("a2", .Cells(Rows.Count, "a").End(xlUp)).Resize(, 16)
    
        ReDim y(1 To UBound(x))
    
    End With
    
    For i = 1 To UBound(x)

        y(i) = x(i, 1) & x(i, 2) & x(i, 3) & "|" & x(i, 4) & "|" & x(i, 5) & "|" & x(i, 15)

    Next
    
    If .Range("c2") <> "" Then
    
        z = .Range("c2", .Cells(Rows.Count, "c").End(xlUp)).Resize(, 2)
    
        ReDim result(1 To UBound(z), 1 To 150)
    
        For i = 1 To UBound(z)
        
            If z(i, 2) <> "" Then
            
                Gamedata = Me.cmbgame.Text & Me.cmbstand.Text & Me.cmbarea.Text & "|" & z(i, 2) & "|"
            
                temp = Filter(y, Gamedata, 1)
            
                If UBound(temp) > -1 Then
                
                    For n = 0 To UBound(temp)
                
                        r_split = Split(temp(n), "|")
                    
                        offs = CLng(r_split(2))
                        seat = r_split(3)
                    
                        k = k + offs + 1
                        
                        result(i, k) = seat
                    
                    Next
                
                End If
                
            End If
            
            k = 0
            
        Next
    
        .Range("e2").Resize(UBound(result), UBound(result, 2)) = result
    
    End If


    
    .Range("a1") = frmgame.cmbgame.Text
    .Columns("E:EX").ColumnWidth = 4.29
    .Columns("B:D").ColumnWidth = 8
  
    'This is the code for colour coding the calendar using the different letters'
   
    With .Range("E2:EX300")
    
        .Replace "P", "RES", xlWhole
        .Replace ".", "S", xlWhole
        .Replace "04", "C", xlWhole
        
        'colouring
        myvalues = Split("A,RES,BS,DS,HP,OB,RV,SV,UV,X,RA,C,S,RR", ",")
        mycolours = Array(4, 10, 10, 10, 10, 10, 10, 10, 10, 15, 45, 41, 3, 27)
        
        With Application.ReplaceFormat
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Font.Bold = True
            With .Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
            End With
        End With
        
        For i = 0 To UBound(mycolours)
            Application.ReplaceFormat.Interior.ColorIndex = mycolours(i)
            .Replace what:=myvalues(i), replacement:=myvalues(i), lookat:=xlWhole, searchformat:=False, ReplaceFormat:=True
        Next

    End With
        
    .Activate

End With

Application.ScreenUpdating = 1

End Sub

merci pour votre aide

 

[Hervé]

Re : probleme boucle VB code

salut

ton souci doit venir de cette ligne de code : With source.Range("A1").CurrentRegion

currentregion sélectionne une plage limité par une colonne vide et une ligne vide.

si tu ajoutes une colonne sans entête entre c et d, currentregion va sélectionner seulement les colonnes a,b et c

solution, ajoute une entête de colonne

a plus

 

[ridhaghanmi]

Re : probleme boucle VB code

merci pour votre réponse rapide .
le problème est dans Private Sub cmdok_Click() la macro qui existe dans le form frmgame.

si j ajoute une colonne entre C et D dans la feuille Gamedata.

merci

 

[Staple1600]

Re : probleme boucle VB code

Bonjour à tous

Le multipostage fait florés ces temps-ci...
copie et transposer données : Excel - VBA

Au moins cela m'aura permis de saluer Hervé

 

[ridhaghanmi]

Re : probleme boucle VB code

Et c est quoi le problème si j ai essaye de resourdre mon problème ailleurs.au moins je sauve un peu de temps et améliore les deux sites par une solution. alors ta réponse staple1600 n est pas malheureusement une solution

 

[Staple1600]

Re : probleme boucle VB code

Re

Le multipostage c'est mieux quand c'est signalé, c'est tout.
Si tu veux comprendre pourquoi, lis ce fil sur l'autre forum.

 

[ridhaghanmi]

Re : probleme boucle VB code

ok je vais signaler ça toute de suite , par contre ça vous empêche pas a m aider et me partager votre expertise. ça sera beaucoup apprécie . merci

 

[Staple1600]

Re : probleme boucle VB code

Re,

Comme dit précédemment par Hervé
(voir ce que dit l'aide de VBA a propos de CurrentRegion)

et pour tester, tu peux ajouter ceci

' le début de ton code
With source.Range("A1").CurrentRegion
Msgbox .address ' pour voir exactement quelle est ta plage de cellules.
'le reste de ton code

PS: Sans rancune ?

 

[ridhaghanmi]

Re : probleme boucle VB code

merci pour votre réponse.
le problème comme j ai spécifie est dans Private Sub cmdok_Click() la macro qui existe dans le form frmgame.

si j ajoute une colonne entre C et D dans la feuille Gamedata et dans les feuilles destination la macro donnes pas ce que je veux.
sinon la macro marche pas ... il ya éventuellement problème de boucle. merci

 

[Staple1600]

Re : probleme boucle VB code

Re,

En relisant ceci

si j ajoute une colonne entre C et D dans la feuille Gamedata et dans les feuilles destination la macro donnes pas ce que je veux.

J'ai fait la macro ci-dessous car si tu inséres une colonne entre C et D
la colonne C devient la colonne D
Testes cette macro sur un classeur vide

Sub Macro2()
[C1] = "TEST"
MsgBox "ESTVIDE C1=" & IsEmpty([C1]) & vbCrLf & [C1]
Range("C1").EntireColumn.Insert
MsgBox "ESTVIDE C1=" & IsEmpty([C1])
MsgBox [C1]
End Sub

Tu comprends désormais où peut être le souci ?

 

[ridhaghanmi]

Re : probleme boucle VB code

merci j ai pas bien compris je suis pas assez expert

 

[Staple1600]

Re : probleme boucle VB code

Re


As-tu testé la macro de mon précédent message ?

On s’aperçoit qu'au départ la valeur TEST est en C1
si on insère une colonne, ce qui était en C1 passe en D1, et C1 devient vide.
C'est ce qu'illustre cette macro.

Or dans ton code, on trouve

If .Range("c2") <> "" Then

Donc si tu insères une colonne en C et D, alors la colonne C sera vide
ce qui doit poser problème à ton code VBA

 

[ridhaghanmi]

Re : probleme boucle VB code

oui je l ai bien teste mais comment je peux l utiliser pour resourdre mon probleme. merci
je suis sur que le probleme es ici

With Sheets("Gamedata")

x = .Range("a2", .Cells(Rows.Count, "a").End(xlUp)).Resize(, 16)

ReDim y(1 To UBound(x))

End With

For i = 1 To UBound(x)

y(i) = x(i, 1) & x(i, 2) & x(i, 3) & "|" & x(i, 4) & "|" & x(i, 5) & "|" & x(i, 15)

Next

If .Range("c2") <> "" Then

z = .Range("c2", .Cells(Rows.Count, "c").End(xlUp)).Resize(, 2)

ReDim result(1 To UBound(z), 1 To 150)

For i = 1 To UBound(z)

If z(i, 2) <> "" Then

Gamedata = Me.cmbgame.Text & Me.cmbstand.Text & Me.cmbarea.Text & "|" & z(i, 2) & "|"

temp = Filter(y, Gamedata, 1)

If UBound(temp) > -1 Then

For n = 0 To UBound(temp)

r_split = Split(temp(n), "|")

offs = CLng(r_split(2))
seat = r_split(3)

k = k + offs + 1

result(i, k) = seat

Next

End If

End If

k = 0

Next

.Range("e2").Resize(UBound(result), UBound(result, 2)) = result

End If

 

[Staple1600]

Re : probleme boucle VB code

Re

Oui mais as-tu compris ce qui en découle ?
Car aprés insertion d'une colonne entre C et D, la colonne C sera vide
Donc le test ci-dessous sera toujours faux non ?
If .Range("c2") <> "" Then

 

[ridhaghanmi]

Re : probleme boucle VB code

oui mais si on ajoute une colonne entre C et D .... Colonne C ne change pas la place. n est ce pas.