Sujet Précédent Sujet Suivant

Code boucle pour remplir les cellules d'un tableau

Fermé
jenny-eg Messages postés 9 Date d'inscription mercredi 1 septembre 2021 Statut Membre Dernière intervention 10 septembre 2021 - 10 sept. 2021 à 10:35
cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 - 10 sept. 2021 à 18:43
Bonjour,
j'ai un code pour chercher automatiquement la distance entre deux villes dans la feuille 2 du fichier joint.
Mon but est de remplir la feuille 1.

(J'avais pensé à la remplir avec un sommeprod feuille 2, 1ere ligne et 1 ere colonne mais je pense que mon fichier va avoir un pb de calcul de processeur...)

Donc j'ai pensé à mettre le code directement sur la feuille 1 pour qu'il remplisse les distances avec le code dans le corps du tableau.
Mais je pense que mon code ne va pas apprécier quand il va arriver aux cellules en noir car c'est la même ville de départ et de destination...

Etant novice en VBA j'ai un peu de mal avec les boucles. HELP

https://www.cjoint.com/c/KIkiGvJ7AGJ
A voir également:

2 réponses

Réponse 1 / 2
cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729
10 sept. 2021 à 11:11
Bonjour,

voici le code. L'exécution est très longue 5 mn 

Option Explicit
'Déclaration d'une constante:
Public Const DIST = "http://www.distance2villes.com/recherche?source="  'URL SITE WEB
Sub boucleville()
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long
Dim URL As String, TXT As String
Dim VilleDepart As String, VilleDestination As String
    Set FL1 = Worksheets("Feuil2")
    NoCol = 1 'lecture de la colonne A
    'Application.ScreenUpdating = False ' a mettre pour ne pas voir défiler
    On Error Resume Next
    For NoLig = 2 To Split(FL1.UsedRange.Address, "$")(4)
        VilleDepart = FL1.Cells(NoLig, NoCol)
        VilleDestination = Cells(NoLig, NoCol + 1)
        If VilleDepart = "" Then Exit Sub
With ActiveSheet
'construction du lien
URL = DIST & VilleDepart & "&destination=" & VilleDestination
With CreateObject("WinHTTP.WinHTTPRequest.5.1")
.Open "GET", URL, False
.Send
TXT = .ResponseText
End With
'extraction nbre km
Range("C" & NoLig) = Split(Split(TXT, "id=""distanciaRuta"">")(1), "</strong>")(0)
'on recupere durée trajet
Range("D" & NoLig) = Split(Split(TXT, "id=""tiempo"">")(1), "</span></strong>")(0)
'on recupere lien Url transforme en lien hypertexte
'Range("E" & NoLig) = URL
'.Hyperlinks.Add .Range("E" & NoLig), URL
End With
    Next
    Set FL1 = Nothing
    'Application.ScreenUpdating = True 'retablir
End Sub


si tu ne veux pas voir la progression active cette ligne: 

Application.ScreenUpdating = False ' a mettre pour ne pas voir défiler


et celle ci: 

Application.ScreenUpdating = True 'retablir
0
Réponse 2 / 2
jenny-eg Messages postés 9 Date d'inscription mercredi 1 septembre 2021 Statut Membre Dernière intervention 10 septembre 2021
10 sept. 2021 à 15:22
Bonjour Mr le Pivert,

Merci beaucoup cela fonctionne et j'avais vraiment un problème pour nommer les col au lieu des cellules et plus de la boucle....
Après 5 min ca va ce n'est pas très long et quand tu l'a fait une fois c'est bon.

Avec ton code je pense que je vais essayer de mieux le comprendre pour le modifier et l'adapter sur la feuille 1. Tu penses que c'est possible?

Dsl mais j'aimerais bien apprendre la VBA et c'est un bon exercice non?
0
cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729
Modifié le 10 sept. 2021 à 15:45
Pour la feuille1, c'est à peu près pareil sauf que la VilleDepart ne bouge pas en A3 

Sub bouclevillefeuille1()
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long
Dim URL As String, TXT As String
Dim VilleDepart As String, VilleDestination As String
    Set FL1 = Worksheets("Feuil1")
    NoCol = 1 'lecture de la colonne A
    'Application.ScreenUpdating = False ' a mettre pour ne pas voir défiler
    On Error Resume Next
    For NoLig = 4 To Split(FL1.UsedRange.Address, "$")(4)
        VilleDepart = FL1.Cells(3, NoCol)  'on reste sur A3 
        VilleDestination = Cells(NoLig, NoCol)  'on boucle à partir de A4
        If VilleDepart = "" Then Exit Sub
With ActiveSheet
'construction du lien
URL = DIST & VilleDepart & "&destination=" & VilleDestination
With CreateObject("WinHTTP.WinHTTPRequest.5.1")
.Open "GET", URL, False
.Send
TXT = .ResponseText
End With
'extraction nbre km
Range("C" & NoLig) = Split(Split(TXT, "id=""distanciaRuta"">")(1), "</strong>")(0)
'on recupere durée trajet
'Range("D" & NoLig) = Split(Split(TXT, "id=""tiempo"">")(1), "</span></strong>")(0)
'on recupere lien Url transforme en lien hypertexte
'Range("E" & NoLig) = URL
'.Hyperlinks.Add .Range("E" & NoLig), URL
End With
 Next
    Set FL1 = Nothing
    'Application.ScreenUpdating = True 'retablir
End Sub


Voilà,

pour les cours vba il y en a plein sur le net en cherchant: Cours vba pour débutant

un exemple:

https://www.excel-pratique.com/fr/vba

@+ Le Pivert
0
cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024 729 > cs_Le Pivert Messages postés 7904 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 14 août 2024
10 sept. 2021 à 18:43
Pour compléter mettre toutes les distances sur la ligne3 correspondant aux villes (exécution longue aussi) 

Sub bouclevilleligne3()
Dim FL1 As Worksheet, NoCol As Integer
Dim NoLig As Long, colonne As Integer
Dim URL As String, TXT As String
Dim VilleDepart As String, VilleDestination As String
    Set FL1 = Worksheets("Feuil1")
    NoCol = 1 'lecture de la colonne A
    colonne = 4 ' demarre colonne D
    'Application.ScreenUpdating = False ' a mettre pour ne pas voir défiler
    On Error Resume Next
    For NoLig = 4 To Split(FL1.UsedRange.Address, "$")(4)
        VilleDepart = FL1.Cells(3, NoCol)
        VilleDestination = Cells(NoLig, NoCol)
        If VilleDepart = "" Then Exit Sub
With ActiveSheet
'construction du lien
URL = DIST & VilleDepart & "&destination=" & VilleDestination
With CreateObject("WinHTTP.WinHTTPRequest.5.1")
.Open "GET", URL, False
.Send
TXT = .ResponseText
End With
'extraction nbre km
Cells(3, colonne) = Split(Split(TXT, "id=""distanciaRuta"">")(1), "</strong>")(0)
'on recupere durée trajet
'Range("D" & NoLig) = Split(Split(TXT, "id=""tiempo"">")(1), "</span></strong>")(0)
'on recupere lien Url transforme en lien hypertexte
'Range("E" & NoLig) = URL
'.Hyperlinks.Add .Range("E" & NoLig), URL
colonne = colonne + 1 'on passe à la colonne suivante
End With
 Next
    Set FL1 = Nothing
    'Application.ScreenUpdating = True 'retablir
End Sub


j'ai mis des commentaires pour que tu comprennes la démarche.

VBA, c'est de la logique!

Amuse toi bien

@+ Le Pivert
0

Discussions similaires

Remplir une cellule (texte) en fonction d'une autre (texte).
SOMUM -
SOMUM -

4 réponses