Sub getquotes()
Dim ws As Worksheet
Dim rngTkr As Range
Dim strTkr As String
Dim c As Range
Set ws = Sheet1
Dim strFld As String
'Données pour la seconde etape
Dim rngTkr2 As Range
Dim d As Range
'transposition des stocks + chopper les données de bloomberg
Range("heud").ClearContents
With ws
Set rngTkr = .Range("A5: A1500").SpecialCells(xlCellTypeConstants) ' ticker range
i = 1
For Each c In rngTkr
strTkr = """" & c.Value & " Equity" & """"
strFld = """" & "PX LAST" & """"
.Range("A1").Offset(4, i + 1).Value = "=BDH(" & strTkr & "," & strFld & ",B1, B2)"
.Range("A1").Offset(3, i + 1).Value = c.Value
i = i + 2
Next
End With
Call copydata
End Sub
Sub copydata()
Dim lngCounter As Long
Dim lngMax As Long
Dim lngCol As Long
Dim wksTwo As Worksheet
Dim rngTkr As Range
Dim c As Range
'copier de la sheet1 a la sheet2, on copie en valeurs
Set wksTwo = Worksheets("Sheet2")
wksTwo.Cells.ClearContents
Worksheets("Sheet3").Cells.ClearContents
Worksheets("Sheet4").Cells.ClearContents
Worksheets("Sheet1").Range("zoneselect").Copy
wksTwo.Range("B1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
' On enleve les blancs entre la sheet 2 à la sheet3
wksTwo.Range("A1:BB1").Copy Sheets("Sheet3").Range("B1")
Sheets("Sheet3").Range("B1").CurrentRegion.SpecialCells(xlCellTypeBlanks).Delete shift:=xlToLeft
Worksheets("Sheet3").Select
Range("A1:BB1").Select
Selection.Cut
Sheets("Sheet3").Select
Range("B1").Select
ActiveSheet.Paste
Selection.SpecialCells(xlCellTypeBlanks).Select
Application.CutCopyMode = False
Selection.Delete shift:=xlToLeft
'************************ Technique pour prendre la periode personnalisee au début en Workday**************************
Dim datStart As Long
Dim datEnd As Long
Dim lngRow As Long
datStart = Range("datedebut")
datEnd = Range("datefin")
lngRow = 2
For lngCounter = datStart To datEnd
With Worksheets("Sheet3").Cells(lngRow, "A")
If (WorksheetFunction.Weekday(CDate(lngCounter), 1) < 7) And (WorksheetFunction.Weekday(CDate(lngCounter), 1) > 1) Then
.Value = CDate(lngCounter)
lngRow = lngRow + 1
End If
End With
Next lngCounter
'************************ FIN Technique pour prendre la periode personnalisee au début en Workday**************************
'****************On selectionne l'action qui a le plus de dates pour la copier dans la sheet3 TECHNIQUE 1**************
' With wksTwo
' For lngCounter = 1 To .Cells(1, .Columns.Count).End(xlToLeft).Column
'
' If InStr(1, Cells(1, lngCounter).Value, "FP") > 0 Then 'ISDATE zone modifiee
'
' If .Cells(.Rows.Count, lngCounter).End(xlUp).Row > lngMax Then
' lngMax = .Cells(.Rows.Count, lngCounter).End(xlUp).Row
' lngCol = lngCounter
' End If
' End If
' Next lngCounter
'
' .Range(.Cells(2, lngCol), .Cells(lngMax, lngCol)).Copy Destination:=Worksheets("Sheet3").Range("A2")
' End With
' ************************************ FIN TECHNIQUE 1 SELECTION *******************************************
' DEBUT VLOOKUP TEST VBA PUR
' Dim Dict As Object
' Dim wsSource As Worksheet, wsTarget As Worksheet
' Dim ValuesToFind As Variant
' Dim RngSource As Range, RngTarget As Range
' Dim LastRow As Long, LastColumn As Long, ArrayCounter As Long, DictCounter As Long, RowIndex As Long'
'
' Set wsSource = Worksheets("Sheet1")
' Set wsTarget = Worksheets("Sheet3")
' With wsTarget
' LastColumn = .Range("B1").End(xlToRight).Column
' ValuesToFind = WorksheetFunction.Transpose(.Range(.Cells(1, 2), .Cells(1, LastColumn)).Value)
' End With
'
' For ArrayCounter = LBound(ValuesToFind) To UBound(ValuesToFind)
' Set Dict = CreateObject("Scripting.Dictionary")
' With wsSource
' Set RngSource = .Rows(4).Find(What:=ValuesToFind(ArrayCounter, 1), After:=.Cells(4, 1), LookIn:=xlValues, LookAt:=xlWhole)
' End With
' If Not RngSource Is Nothing Then
' LastRow = RngSource.End(xlDown).Row
' For RowIndex = 1 To (LastRow - 4)
' Dict.Add RngSource.Offset(RowIndex, 0).Value, RngSource.Offset(RowIndex, 1).Value
' Next RowIndex
' With wsTarget
' LastRow = .Range("A" & Rows.Count).End(xlUp).Row
' Set RngTarget = .Rows(1).Find(What:=ValuesToFind(ArrayCounter, 1), After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole)
' If Not RngTarget Is Nothing Then
' For DictCounter = 2 To LastRow
' If Dict.Exists(.Range("A" & DictCounter).Value) Then
' RngTarget.Offset(DictCounter - 1, 0).Value = Dict.Item(.Range("A" & DictCounter).Value)
' End If
' Next DictCounter
' End If
' End With
' End If
' Dict.RemoveAll
' Set Dict = Nothing
' Next ArrayCounter
' FIN VLOOKUP TEST VBA PUR
'DEBUT TEST VLOOOKUP FORMULE EXCEL
LgDep = 2 ' Ligne de départ du tableau dans la page Sheet2
ClDep = 2 ' Colonne de départ du tableau dans la page Sheet2
With Sheets("Sheet2")
ClFin = .Cells(LgDep, Columns.Count).End(xlToLeft).Column
LgFin = .Range(.Cells(1, ClDep), .Cells(1, ClFin)).EntireColumn.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End With
Nblg = Range("A" & Rows.Count).End(xlUp).Row
For i = ClDep To ClFin Step 2
With Range(Cells(2, 2 + (i - ClDep) / 2), Cells(Nblg, 2 + (i - ClDep) / 2))
.Formula = "=VLOOKUP(RC1,Sheet2!R" & LgDep & "C" & i & ":R" & Nblg & "C" & i + 1 & ",2,TRUE)"
End With
Next i
'FIN TEST VLOOOKUP FORMULE EXCEL
Cells.Select
Selection.Copy
Sheets("Sheet4").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Range("A1").Select
'VLOOKUP infini test
' I = 1
' For Each c In rngTkr
' Set rngTkr = Worksheets("Sheet1").Range("A5: A1500").SpecialCells(xlCellTypeConstants)
'
'
' I = I + 1
'Début du VLOOKUP il faudrait le généraliser en fonction du nombre de stocks
'Sheets("Sheet3").Select
'Range("B2").Select
' ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Sheet2!RC:R[5563]C[1],2,TRUE)"
'Range("B2").Select
'Selection.AutoFill Destination:=Range("B2:B5565")
'Range("B2:B5565").Select
' ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Sheet2!R2C2:R5565C3,2,TRUE)"
' Range("C2").Select
' ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],Sheet2!R2C4:R5565C5,2,TRUE)"
' Range("D2").Select
' ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-3],Sheet2!R2C6:R5565C7,2,TRUE)"
' Range("C2").Select
' Selection.AutoFill Destination:=Range("C2:C5565")
' Range("C2:C5565").Select
' Range("D2").Select
' Selection.AutoFill Destination:=Range("D2:D5565")
' Range("D2:D5565").Select
End Sub
Here is the file :
Bookmarks