所以這裏是我一起炒的代碼。它不漂亮,但它的工作原理和做它應該做的事情。任何來自社區的格式提示都將不勝感激。
Sub WeightedScore()
'
' WeightedScore Macro
'
' This will allow me to use a dynamic range of rows when sorting the table toward the end of the macro.
Dim LastRow As Integer
' This part is just some asthetic cleanup from the report that is generated
Rows("4:4").Select
Selection.Delete Shift:=xlUp
Columns("D:F").Select
Selection.Delete Shift:=xlToLeft
' These are the weights to be applied to each factor
Range("A1").Select
ActiveCell.FormulaR1C1 = "0.25"
Range("B1").Select
ActiveCell.FormulaR1C1 = "0.25"
Range("C1").Select
Selection.FormulaR1C1 = "0.5"
' This part essentially counts the rows to be sorted in the table toward the end of the macro
LastRow = Range("E3").CurrentRegion.Cells(Range("E3").CurrentRegion.Cells.Count).Row
' This code allows for the minimum and maximum values in the data column regardless of number of rows
Range("C4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.FormulaR1C1 = "=MIN(R4C3:R[-1]C)"
Range("D4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.FormulaR1C1 = "=MAX(R4C4:R[-1]C)"
Range("E4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.FormulaR1C1 = "=MIN(R4C5:R[-1]C)"
' This part is essentially admitting defeat, copying the min/max values below a variable number
' of rows, and then pasting them into static cells at the top of the sheet.
Range("C3").Select
Selection.End(xlDown).Select
Selection.Copy
Range("C2").PasteSpecial xlPasteValues
Range("D3").Select
Selection.End(xlDown).Select
Selection.Copy
Range("D2").PasteSpecial xlPasteValues
Range("E3").Select
Selection.End(xlDown).Select
Selection.Copy
Range("E2").PasteSpecial xlPasteValues
' This part names the "Score" column and applies the absolute weights and absolute min/max values
' to the relative cell values.
Range("F3").Select
Selection.FormulaR1C1 = "Score"
Range("F4").Select
Selection.FormulaR1C1 = _
"=1/(RC[-3]/R2C3)*R1C1+RC[-2]/R2C4*R1C2+RC[-1]/R2C5*R1C3"
Selection.NumberFormat = "#,##0.00"
Selection.Copy
ActiveCell.Offset(0, -1).Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(-1, 1).Range("A1").Select
Range(Selection, Selection.End(xlUp)).Select
ActiveSheet.Paste
' This is where the data is selected and sorted based on the "Score" value above. The LastRow
' function as described earlier allows for a dynamic range of rows.
Range("A3:F" & LastRow).Select
ActiveWorkbook.Worksheets("Reports").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Reports").Sort.SortFields.Add Key:=Range("F4:F" & LastRow _
), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Reports").Sort
.SetRange Range("A3:F" & LastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' This last part ends the macro with the highest "Score" selected
Range("F4").Select
End Sub
我希望這可以幫助任何有類似問題的人。
您是否知道使用宏的相對參考? – pnuts 2015-02-05 22:01:40