Код перестает работать правильно в середине выполнения - PullRequest
2 голосов
/ 30 сентября 2019

Я пытаюсь собрать данные о статистике игрока из одной электронной таблицы, выполнить расчет этих данных, а затем вставить эти данные в ячейку на другом листе, если имена совпадают.

Это немного сложнопоскольку на листе с данными статистики меньше записей, чем на моем другом листе, а имена - это сокращенные версии, а не полные имена.

Я использовал функцию Range.Find, чтобы проверить, находятся ли имена игроков на листе статистики в ячейках имен первого листа, и, если это так, вставить формулу.

На данный момент мой подход заключается в следующем: 1. выполнить поиск в длинном списке, чтобы увидеть, существует ли имя листа статистики в длинном наборе имен. 2. если оно существует, проверьте, соответствует ли имя в длинном списке строке текущегоячейка совпадает с именем в таблице статистики, и если нет, перейдите к следующей ячейке в длинном списке и проверьте еще раз. 3. повторяйте, пока у меня не будет расположения ячейки, соответствующей имени ячейки таблицы статистики, и заполните формулу в ячейке в той же строке, что и имя в длинном списке.

Мой код(он начинает говорить, что все имена отсутствуют в списке, даже если они есть):

'
' PlayerImpact Macro
'

'
Dim rng As Range, cell As Range, PSrng As Range, player As Range, namerng As Range, FDaddress As Range, playercheck As Range
'Dim namek As String
Dim i As Long, j As Long, k As Long
Dim a As Single, b As Single, c As Single, d As Single, tot As Single
Set rng = Sheet1.Range("P2:P542")
Set namerng = Sheet1.Range("A2:A542")
Set PSrng = Sheet6.Range("A2:S390")
k = 1
i = 2
j = 2
'For j = 1 To rng.Rows.Count
Do While j < rng.Rows.Count
    Debug.Print " "
    Debug.Print "i: " & " " & i
    Debug.Print "j: " & " " & j
    Debug.Print "k: " & " " & k
    Debug.Print "Filtered Data Player:" & " " & namerng(k)
    Debug.Print "Stats Player:" & " " & PSrng.Cells(i, 3).Value
    Set cell = rng(j)
    Set player = namerng.Find(PSrng.Cells(i, 3).Value, LookIn:=xlValues, Lookat:=xlPart)
    If Not player Is Nothing Then
            Debug.Print "namerange loop: " & " " & player.Value
            Debug.Print "namerange k in loop: " & " " & namerng(k)
            Debug.Print "Stats Player in loop:" & " " & PSrng.Cells(i, 3).Value
            Set playercheck = namerng(k).Find(PSrng.Cells(i, 3).Value, LookIn:=xlValues, Lookat:=xlPart)
            If Not playercheck Is Nothing Then
                j = k
                'cell.Formula = "=('Player Stats Value'!G" & (i + 1) & "-'Player Stats Value'!$G$2)/'Player Stats Value'!$G$2+('Player Stats Value'!I" & (i + 1) & "-'Player Stats Value'!$I$2)/'Player Stats Value'!$I$2+('Player Stats Value'!J" & (i + 1) & "-'Player Stats Value'!$J$2)/(2*'Player Stats Value'!$J$2)+('Player Stats Value'!K" & (i + 1) & "-'Player Stats Value'!$K$2)/(2*'Player Stats Value'!$K$2)+('Player Stats Value'!Q" & (i + 1) & "-'Player Stats Value'!$Q$2)"
                i = i + 1
                k = k + 1
                j = j + 1
                Debug.Print "In List, Player Check Match: " & " " & player.Value
                Debug.Print "Playercheck Value: " & " " & playercheck.Value
            Else
                Debug.Print "In List, No match Player Check:" & " " & player.Value
                k = k + 1
                If k > namerng.Rows.Count Then
                    k = 1
                End If
            End If
    Else
      Debug.Print "Not in List: " & " " & PSrng.Cells(i, 3).Value
      i = i + 1
      'cell.Value = 0
      j = j + 1
      'k = k + 1
    End If
Loop

здесь можно увидеть две таблицы

Образецвывод, когда он начинает идти не так:


i:  13
j:  14
k:  14
Filtered Data Player: Ademola Lookman
Stats Player: Adrián
namerange loop:  Adrián San Miguel del Castillo
namerange k in loop:  Ademola Lookman
Stats Player in loop: Adrián
In List, No match Player Check: Adrián San Miguel del Castillo

i:  13
j:  14
k:  15
Filtered Data Player: Adrian Mariappa
Stats Player: Adrián
namerange loop:  Adrián San Miguel del Castillo
namerange k in loop:  Adrian Mariappa
Stats Player in loop: Adrián
In List, No match Player Check: Adrián San Miguel del Castillo

i:  13
j:  14
k:  16
Filtered Data Player: Adrián San Miguel del Castillo
Stats Player: Adrián
namerange loop:  Adrián San Miguel del Castillo
namerange k in loop:  Adrián San Miguel del Castillo
Stats Player in loop: Adrián
In List, Player Check Match:  Adrián San Miguel del Castillo
Playercheck Value:  Adrián San Miguel del Castillo

i:  14
j:  17
k:  17
Filtered Data Player: Ahmed El Mohamady
Stats Player: Adrian Mariappa
Not in List:  Adrian Mariappa

i:  15
j:  18
k:  17
Filtered Data Player: Ahmed El Mohamady
Stats Player: Ahmed Elmohamady
Not in List:  Ahmed Elmohamady

i:  16
j:  19
k:  17
Filtered Data Player: Ahmed El Mohamady
Stats Player: Ainsley Maitland-Niles
Not in List:  Ainsley Maitland-Niles

i:  17
j:  20
k:  17
Filtered Data Player: Ahmed El Mohamady
Stats Player: Alex Iwobi
Not in List:  Alex Iwobi

1 Ответ

1 голос
/ 30 сентября 2019

Из того, что я понимаю о вашей проблеме, этот код должен делать все, что вы ищете:

Sub PlayerImpact()

Dim rng As Range, namerng As Range, PSrng As Range
Dim lngCol As Long

Set rng = Sheet1.Range("P2:P542")
Set namerng = Sheet1.Range("A2:A542")
Set PSrng = Sheet6.Range("C3:C390")

For j = 1 To namerng.Rows.Count

    If Not PSrng.Find(namerng(j).Value2, LookIn:=xlValues, Lookat:=xlPart) Is Nothing Then
        lngRow = PSrng.Find(namerng(j).Value2, LookIn:=xlValues, Lookat:=xlPart).Row

        rng(j).Formula = "=('Player Stats Value'!G" & lngRow & "-'Player Stats Value'!$G$2)/" & _
        "'Player Stats Value'!$G$2+('Player Stats Value'!I" & lngRow & "-'Player Stats Value'!$I$2) /" & _
        "'Player Stats Value'!$I$2+('Player Stats Value'!J" & lngRow & "-'Player Stats Value'!$J$2)/" & _
        "(2*'Player Stats Value'!$J$2)+('Player Stats Value'!K" & lngRow & "-'Player Stats Value'!$K$2)/" & _
        "(2*'Player Stats Value'!$K$2)+('Player Stats Value'!Q" & lngRow & "-'Player Stats Value'!$Q$2)"
    Else
        rng(j).Value2 = 0 'alternative: rng(j).Value2 = ""
    End If

Next

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...