Question

我有一张这样的表：

第一行是分数。第一列是一个值。在表格中，分数的值是多少倍。

然后我有另一张这样的表：

第一行和第一行代表值（上表第一列）

我的目标是让一个宏能够在seconde表中报告得分（1,2,3,4）。它必须报告具有最大数量的分数。

例如，在表1中，值-3,53的得分为“1”的3倍，得分为“4”的1倍。所以它应该在seconde表中报告得分“1”。

Answer 1

我找到了。如果有人遇到与我相同的问题，我会发布代码：

Sub test()
    Dim MyRange As Range, AllRange As Range
    Dim MyRow As Range, i As Long, MyCol As Integer
    Dim MyDicoScores As New Dictionary
    Dim MyDicoCorres As New Dictionary, MyKey As Variant, MyDiff As Integer
        'On determine un dico de score
    With ThisWorkbook.Worksheets("Scores")

        Set AllRange = .Range("A1").CurrentRegion.Resize(.Range("A1").CurrentRegion.Rows.Count - 2, .Range("A1").CurrentRegion.Columns.Count).Offset(1)


        Set AllRow = .Range(.Range("A1").Offset(, 1), .Range("A1").End(xlToRight))
            'Dictionnaire de correspondance
        For Each MyRange In AllRow.Cells
            If Not MyDicoCorres.Exists(MyRange.Column) Then
                MyDicoCorres.Add MyRange.Column, MyRange.Value
            End If
        Next MyRange
        For Each MyRange In AllRange.Columns(1).Cells
            MyValue = 0
            For i = 1 To MyDicoCorres.Count
                If Not (MyRange.Offset(, i).Value = "") And (MyRange.Offset(, i).Value > MyValue) Then
                    MyValue = MyRange.Offset(, i).Value
                    MyCol = MyRange.Offset(, i).Column

                End If
            Next i
            If Not MyDicoScores.Exists(MyRange.Value) Then
                MyDicoScores.Add MyRange.Value, MyDicoCorres(MyCol)
            End If
        Next MyRange

    End With
            'On met les valeurs dans le deuxieme tableau
        For Each MyKey In MyDicoScores.Keys
            i = 0
            If MyKey < 0 Then
                With ThisWorkbook.Worksheets("Negatif").UsedRange
                    Set MyRange = .Columns(1).Range("A1")
                    While MyKey <= MyRange.Offset(i).Value
                       i = i + 1
                    Wend
                        'On remonte
                    MyRange.Offset(i - 1, Int(((Abs(MyKey - MyRange.Offset(i - 1).Value)) * 100)) + 1).Value = MyDicoScores(MyKey)
                End With
            Else
                With ThisWorkbook.Worksheets("Positive").UsedRange
                    Set MyRange = .Columns(1).Range("A1")
                    While MyKey >= MyRange.Offset(i).Value
                       i = i + 1
                    Wend
                    MyRange.Offset(i - 1, Int(((Abs(MyKey - MyRange.Offset(i - 1).Value)) * 100)) + 1).Value = MyDicoScores(MyKey)
                End With
            End If
        Next MyKey
End Sub

在表格中查找值并在另一个二维表格中报告特定分数

1 个答案: