Code boucle pour remplir les cellules d'un tableau

jenny-eg Messages postés 9 Date d'inscription Statut Membre Dernière intervention -
cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention - 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

Afficher la suite

A voir également:

Code boucle pour remplir les cellules d'un tableau
Code ascii - Guide
Tableau word - Guide
Trier un tableau excel - Guide
Comment déverrouiller un téléphone quand on a oublié le code - Guide
Formule excel pour additionner plusieurs cellules - Guide

2 réponses

Réponse 1 / 2

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

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

Réponse 2 / 2

jenny-eg Messages postés 9 Date d'inscription Statut Membre Dernière intervention

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?

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729

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

cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention 729 > cs_Le Pivert Messages postés 7904 Date d'inscription Statut Contributeur Dernière intervention

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

Votre réponse