boucle VBA (recherche à partir d'un nom et copier coller)

**billy255** · 26/03/2014, 11h51

Bonjour à tout le monde,

je viens de m'inscrire ici, tout nouveau,
j'ai bloqué sur mon fichier,
je voulais juste copier le nom de l'hôtel et le tarif de l'agence qui le propose, dans une autre feuille , pour l' tarif je souhaiterai copier celui qui a été proposé par le site officiel de l'hôtel ou bien la première agence qui le propose
comme j'aurai à faire la même manipulation plusieurs fois par jour , donc je cherche un code Vba, si c'est possible

le code va parcourir la feuille et copier au fur à mesure les hôtels que j'ai choisis, avec leur tarifs

VEUILLEZ TROUVER CE QUE JE CHERCHE A PRODUIRE DANS L ONGLET RÉSULTAT

je vous remercie,
Cordialement,

**arosec** · 20/05/2014, 21h48

Bonsoir,

J'ai écrit une macro qui tente de transformer et consolider les onglets 23,24, ... dans un onglet unique "Data".
Il suffit ensuite de consulter le résultat dans le pivot. (voir fichier en pj)

J'espère que cela pourra t'aider un peu!

Cdlt,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
 
Option Explicit
 
Type typHotel
  Nom As String
  Indice As String
  Ville As String
End Type
 
Type typPrix
  Source As String
  Prix As String
End Type
 
Sub ChargerOngletInternetDansData()
Dim shSrc As Worksheet
Dim shDst As Worksheet
Dim shPiv As Worksheet
Dim pt As PivotTable
Dim rSrc As Long
Dim rDst As Long
Dim th As typHotel
Dim tp As typPrix
 
  For Each shDst In ThisWorkbook.Worksheets
    If shDst.Name = "Data" Then Exit For
  Next shDst
  If shDst Is Nothing Then
    Set shDst = ThisWorkbook.Worksheets.Add()
    shDst.Name = "Data"
  End If
  If shDst.Name <> "Data" Then
    Set shDst = ThisWorkbook.Worksheets.Add()
    shDst.Name = "Data"
  End If
 
  'Vider le data
  shDst.Select
  shDst.Cells.Delete
 
  shDst.Cells(1, 1) = "Date"
  shDst.Cells(1, 2) = "Hotel"
  shDst.Cells(1, 3) = "Ville"
  shDst.Cells(1, 4) = "Indice"
  shDst.Cells(1, 5) = "Source"
  shDst.Cells(1, 6) = "Prix"
 
  rDst = 1
 
  For Each shSrc In ThisWorkbook.Worksheets
    rSrc = 0
    If IsNumeric(shSrc.Name) Then
      While rSrc < shSrc.UsedRange.Rows.Count
        rSrc = rSrc + 1
        If shSrc.Cells(rSrc, 1) = "+" Then
          rSrc = rSrc + 1
 
          th.Nom = shSrc.Cells(rSrc, 1)
          rSrc = rSrc + 1
          th.Indice = shSrc.Cells(rSrc, 1)
          rSrc = rSrc + 1
          th.Ville = shSrc.Cells(rSrc, 1)
          rSrc = rSrc + 1
          While Not IsNumericPersonal(shSrc.Cells(rSrc, 1))
            rDst = rDst + 1
 
            tp = decompposeSourcePrix(shSrc.Cells(rSrc, 1))
 
            shDst.Cells(rDst, 1) = shSrc.Name
            shDst.Cells(rDst, 2) = th.Nom
            shDst.Cells(rDst, 3) = th.Indice
            shDst.Cells(rDst, 4) = th.Ville
            shDst.Cells(rDst, 5) = tp.Source
            shDst.Cells(rDst, 6) = tp.Prix
            rSrc = rSrc + 1
          Wend
        End If
      Wend
    End If
  Next shSrc
 
  Set shDst = Nothing
  Set shSrc = Nothing
 
  Set shPiv = ThisWorkbook.Worksheets("Pivot")
  Set pt = shPiv.PivotTables(1)
  pt.RefreshTable
  Set pt = Nothing
  Set shPiv = Nothing
End Sub
 
Function IsNumericPersonal(s As String) As Boolean
  s = Trim(s)
  If s = "" Then
    IsNumericPersonal = False
  Else
    IsNumericPersonal = IsNumeric(s)
  End If
End Function
 
Function decompposeSourcePrix(s As String) As typPrix
Dim tp As typPrix
Dim str As String
Dim tmp As String
Dim i As Integer
 
  str = ""
  For i = Len(s) To 1 Step -1
    tmp = Mid(s, i, 1)
    If tmp <> "€" And Not IsNumeric(tmp) Then Exit For
    str = tmp & str
  Next i
  tp.Prix = str
  tp.Source = Replace(s, str, "")
  decompposeSourcePrix = tp
End Function

**billy255** · 21/05/2014, 10h43

bonjour,
je te remercie pour la réponse,
ton idée est intéressante, mais si je souhaite faire ça sur un mois, ça va devenir trop long, et aussi, j'aurai aimé prendre que le tarif du site internet ou bien celui de Expedia, si aucun n'existe, faut prendre le tarif de l'agence qui vient après

merci

Envoyé par arosec

Bonsoir,

J'ai écrit une macro qui tente de transformer et consolider les onglets 23,24, ... dans un onglet unique "Data".
Il suffit ensuite de consulter le résultat dans le pivot. (voir fichier en pj)

J'espère que cela pourra t'aider un peu!

Cdlt,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
 
Option Explicit
 
Type typHotel
  Nom As String
  Indice As String
  Ville As String
End Type
 
Type typPrix
  Source As String
  Prix As String
End Type
 
Sub ChargerOngletInternetDansData()
Dim shSrc As Worksheet
Dim shDst As Worksheet
Dim shPiv As Worksheet
Dim pt As PivotTable
Dim rSrc As Long
Dim rDst As Long
Dim th As typHotel
Dim tp As typPrix
 
  For Each shDst In ThisWorkbook.Worksheets
    If shDst.Name = "Data" Then Exit For
  Next shDst
  If shDst Is Nothing Then
    Set shDst = ThisWorkbook.Worksheets.Add()
    shDst.Name = "Data"
  End If
  If shDst.Name <> "Data" Then
    Set shDst = ThisWorkbook.Worksheets.Add()
    shDst.Name = "Data"
  End If
 
  'Vider le data
  shDst.Select
  shDst.Cells.Delete
 
  shDst.Cells(1, 1) = "Date"
  shDst.Cells(1, 2) = "Hotel"
  shDst.Cells(1, 3) = "Ville"
  shDst.Cells(1, 4) = "Indice"
  shDst.Cells(1, 5) = "Source"
  shDst.Cells(1, 6) = "Prix"
 
  rDst = 1
 
  For Each shSrc In ThisWorkbook.Worksheets
    rSrc = 0
    If IsNumeric(shSrc.Name) Then
      While rSrc < shSrc.UsedRange.Rows.Count
        rSrc = rSrc + 1
        If shSrc.Cells(rSrc, 1) = "+" Then
          rSrc = rSrc + 1
 
          th.Nom = shSrc.Cells(rSrc, 1)
          rSrc = rSrc + 1
          th.Indice = shSrc.Cells(rSrc, 1)
          rSrc = rSrc + 1
          th.Ville = shSrc.Cells(rSrc, 1)
          rSrc = rSrc + 1
          While Not IsNumericPersonal(shSrc.Cells(rSrc, 1))
            rDst = rDst + 1
 
            tp = decompposeSourcePrix(shSrc.Cells(rSrc, 1))
 
            shDst.Cells(rDst, 1) = shSrc.Name
            shDst.Cells(rDst, 2) = th.Nom
            shDst.Cells(rDst, 3) = th.Indice
            shDst.Cells(rDst, 4) = th.Ville
            shDst.Cells(rDst, 5) = tp.Source
            shDst.Cells(rDst, 6) = tp.Prix
            rSrc = rSrc + 1
          Wend
        End If
      Wend
    End If
  Next shSrc
 
  Set shDst = Nothing
  Set shSrc = Nothing
 
  Set shPiv = ThisWorkbook.Worksheets("Pivot")
  Set pt = shPiv.PivotTables(1)
  pt.RefreshTable
  Set pt = Nothing
  Set shPiv = Nothing
End Sub
 
Function IsNumericPersonal(s As String) As Boolean
  s = Trim(s)
  If s = "" Then
    IsNumericPersonal = False
  Else
    IsNumericPersonal = IsNumeric(s)
  End If
End Function
 
Function decompposeSourcePrix(s As String) As typPrix
Dim tp As typPrix
Dim str As String
Dim tmp As String
Dim i As Integer
 
  str = ""
  For i = Len(s) To 1 Step -1
    tmp = Mid(s, i, 1)
    If tmp <> "€" And Not IsNumeric(tmp) Then Exit For
    str = tmp & str
  Next i
  tp.Prix = str
  tp.Source = Replace(s, str, "")
  decompposeSourcePrix = tp
End Function

boucle VBA (recherche à partir d'un nom et copier coller)

Microsoft Office

Discussions similaires

Partager

Partager