请问这个是用数组还是字典呢？

answer6141

完整的文件发上来

excel海

可以直接搞定的
Sub test()
    Dim i, n, arr
    Dim dic
    Set dic = CreateObject("scripting.dictionary")
    n = Sheet2.Cells(Rows.Count, 2).End(xlUp).Row
    For i = 2 To n
        If Sheet2.Cells(i, 2) <> "" Then
            dic(Sheet2.Cells(i, 2).Offset(0, -1).MergeArea.Cells(1, 1).Value & Sheet2.Cells(i, 2).Value) = ""
        End If
    Next
    keys = dic.keys
    arr = Sheet1.UsedRange
    ReDim brr(1 To UBound(arr) - 1, 1 To 1)
    For i = 2 To UBound(arr)
        For j = 0 To dic.Count - 1
            If InStr(keys(j), arr(i, 7)) > 0 Then
                Select Case Left(keys(j), 2)
                Case "一区"
                    Select Case arr(i, 9)
                    Case Is <= 3
                        brr(i - 1, 1) = 6
                    Case Is <= 4
                        brr(i - 1, 1) = 9
                    Case Is <= 5
                        brr(i - 1, 1) = 11
                    Case Else
                        brr(i - 1, 1) = (Application.WorksheetFunction.Round((arr(i, 9) - 3), 0)) * 1 + 6
                    End Select
                Case "二区"
                    Select Case arr(i, 9)
                    Case Is <= 3
                        brr(i - 1, 1) = 7
                    Case Is <= 4
                        brr(i - 1, 1) = 11
                    Case Is <= 5
                        brr(i - 1, 1) = 12
                    Case Else
                        brr(i - 1, 1) = Application.WorksheetFunction.Round((arr(i, 9) - 3), 0) * 2 + 7
                    End Select
                Case "三区"
                    Select Case arr(i, 9)
                    Case Is < 1
                        brr(i - 1, 1) = 12
                    Case Is >= 1
                        brr(i - 1, 1) = (Application.WorksheetFunction.Round((arr(i, 9) - 1), 0)) * 10 + 12
                    End Select
                Case "四区"
                    Select Case arr(i, 9)
                    Case Is < 1
                        brr(i - 1, 1) = 18
                    Case Is >= 1
                        brr(i - 1, 1) = (Application.WorksheetFunction.Round((arr(i, 9) - 1), 0)) * 20 + 18
                    End Select
                End Select
                Exit For
            End If
        Next
    Next
    Sheet1.Cells(2, "j").Resize(UBound(brr)) = brr
End Sub

高宏飞

micch 发表于 2020-1-12 18:04
这样写代码很麻烦，如果计算价格变动，还需要手工修改代码里的数字。应该做个标准表，存入数组引用，或者存 ...

感谢感谢，之前被隔离，没有机会用电脑。非常感谢这个建议

高宏飞

tptopy 发表于 2020-1-12 20:41
试试这个可是你要的结果

感谢感谢，之前被隔离，没有机会用电脑。谢谢了

高宏飞

answer6141 发表于 2020-1-12 23:02

感谢。可以用。还可以趁机熟练一下字典。哈哈

高宏飞

excel海 发表于 2020-1-13 00:52
可以直接搞定的
Sub test()
    Dim i, n, arr

感谢感谢，之前被隔离，没有机会用电脑。非常感谢！

高宏飞

answer6141 发表于 2020-1-13 00:01
完整的文件发上来

感谢感谢，之前被隔离，没有机会用电脑。非常感谢