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 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 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:

Code boucle pour remplir les cellules d'un tableau
Tableau croisé dynamique - Guide
Code ascii tableau - Guide
Formule excel pour additionner plusieurs cellules - Guide
Tableau word - Guide
Code puk bloqué - Guide

2 réponses

Réponse 1 / 2

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
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

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?

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
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

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728 > cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 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

Discussions similaires

liste de noms par ordre alphabétique

Code de renvoi d'appel : Ooredo, Mobilis...

Codes bateaux et avion GTA vice city Stories

Discussions similaires

Newsletters