根据旧列添加结果

时间:2016-06-01 15:21:32

标签: excel vba excel-vba

enter image description here

我正在比较拖曳释放并按照图片对结果进行排序。第2版​​中的新功能与使用这些功能的社区及其PNR的百分比。我需要在列P中添加百分比的总和,如功能加上他们的PNRS的百分比。然后我们将:“总百分比:37.97%”

如果有人可以帮助我,这是我正在使用的代码:

Sub essai()
    Dim verif As Range, m As Range, dico As New Dictionary
    x = Sheets(1).Range("C4:C" & Sheets(1).Range("C:C").End(xlDown).Row).Count
    y = Sheets(1).Range("I4:I" & Sheets(1).Range("I:I").End(xlDown).Row).Count

    For j = 3 To y + 3
    If Not dico.Exists(Sheets(1).Cells(j, 10).Value) Then
        dico.Add Sheets(1).Cells(j, 10).Value, Sheets(1).Cells(j, 10).Value
        PNRt = PNRt + Sheets(1).Cells(j, 10).Value
    End If
    Next j

    For j = 3 To y + 3

    a = Sheets(1).Range("O1:O" & Sheets(1).Range("O:O").End(xlDown).Row).Count + 1

    Set m = Sheets(1).Range(Sheets(1).Cells(3, 3), Sheets(1).Cells(x + 3, 3)).Find(Sheets(1).Cells(j, 9).Value)

    If m Is Nothing Then
    PNR = 1 - (PNRt - Sheets(1).Cells(j, 10).Value) / PNRt

    PNR = Format(PNR, "0.00%")
    Set verif = Sheets(1).Range("N:N").Find(Sheets(1).Cells(j, 9).Value)

   If verif Is Nothing Then
        Sheets(1).Cells(a, 14).Value = Sheets(1).Cells(j, 9).Value
        texte = Sheets(1).Cells(j, 7).Value & Sheets(1).Cells(j, 8).Value & ", pourcentage PNR : " & PNR
        Sheets(1).Cells(a, 15).Value = texte

    Else
        texte = Sheets(1).Cells(verif.Row, 15).Value
        texte = texte & "; " & Sheets(1).Cells(j, 7).Value & Sheets(1).Cells(j, 8).Value & ", pourcentage PNR : " & PNR
        Sheets(1).Cells(verif.Row, 15).Value = texte

    End If

    End If
    Next j
    Exit Sub


End Sub

1 个答案:

答案 0 :(得分:0)

行后

PNR = 1 - (PNRt - Sheets(1).Cells(j, 10).Value) / PNRt

添加

PNR_VAL = PNR
If verif Is Nothing Then
    Sheets(1).Cells(a, 14).Value = Sheets(1).Cells(j, 9).Value
    texte = Sheets(1).Cells(j, 7).Value & Sheets(1).Cells(j, 8).Value & ", pourcentage PNR : " & PNR
    Sheets(1).Cells(a, 15).Value = texte
    Sheets(1).Cells(a,16).value = PNR_VAL
    Sheets(1).Cells(a,17).value = 1
Else
    if Sheets(1).Cells(verif.Row,17) < 5 then
        texte = Sheets(1).Cells(verif.Row, 15).Value
        texte = texte & "; " & Sheets(1).Cells(j, 7).Value & Sheets(1).Cells(j, 8).Value & ", pourcentage PNR : " & PNR
        Sheets(1).Cells(verif.Row, 15).Value = texte
    end if
    Sheets(1).Cells(verif.Row,16).Value = Sheets(1).Cells(verif.Row,16).Value + PNR_VAL
    Sheets(1).Cells(verif.Row,17).Value = Sheets(1).Cells(verif.Row,17).Value+1
End If

这应该有效