VBA - Loops и WorkSheetFunction.vlookup дали частичные и неверные результаты? - PullRequest
0 голосов
/ 21 февраля 2019

У меня есть рабочая тетрадь с несколькими листами.Каждый лист имеет 6 столбцов, столбец 1 имеет повторяющиеся значения.Мне нужно сгенерировать уникальные значения из столбца 1 в столбец 9, затем выполнить vlookup x, чтобы сопоставить со столбцом 1, и если сопоставить с конкретным значением в столбце 2, то x = значение в столбце 3. Те же задачи, чтобы привести к y = значение встолбец 6. Тогда yx = клетки (1,9).Следует продолжить вниз по списку.Сделайте все вышеперечисленное на всех листах.

Ниже приведены мои коды.Когда я запускал коды, мне приходилось бегать дважды.Я получил частичные результаты на листе 1. Затем то же значение для каждого уникального значения в других листах.Пожалуйста помоги.Кроме того, что было бы лучшим способом сделать это?Спасибо.

Sub UniquelistWorking()
Dim Ticker As String
Dim YearOpen As Double
Dim YearClose As Double
Dim PercentChange As Double
Dim TotalStockVolume As Long
Dim ws As Worksheet
Dim LastRow As Long
Dim lastrowdata As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
lastrowdata = Cells(Rows.Count, "I").End(xlUp).Row
Dim myrange As Range
Set myrange = Range("A:G")
Dim i As Integer
On Error Resume Next

For Each ws In ThisWorkbook.Sheets
    ws.Select

    Range("I1").Value = "Ticker"
    Range("J1").Value = "Yearly Change"
    Range("K1").Value = "Percent Change"
    Range("L1").Value = "Total Stock Volumn"

    ActiveSheet.Range("A2:A" & LastRow).AdvancedFilter , Action:=xlFilterCopy, CopyToRange:=ActiveSheet.Range("I2"), Unique:=True

    For i = 2 To lastrowdata

        If Application.WorksheetFunction.VLookup(Cells(i, 9), myrange, 2, False) = 20160101 Then

              YearOpen = Application.WorksheetFunction.VLookup(Cells(i, 9), myrange, 3, False)

        End If

        If Application.WorksheetFunction.VLookup(Cells(i, 9), myrange, 2, False) = 20161230 Then

           YearClose = Application.WorksheetFunction.VLookup(Cells(i, 9), myrange, 6, False)

        End If

        Cells(i, 10).Value = YearClose - YearOpen
    Next i   
 Next ws
End Sub
...