2015-02-05 133 views
0

我正在尋找一些宏代碼的幫助。我在列A-E中有數據,但這些列中的行可能會每天都在變化。我需要一種方法來計算列C & E中的最小值以及列D中的最大值。然後在列F中,我想根據列C-E中的值及其與最小/最大值的關係來分配一個分數。例如,如果有29行數據和一個標題,則單元C31將具有在列D &E中具有類似設置的公式「= MIN(C2:C30)」。然後,單元F2將具有公式「= 0.25 *(1 /(C2/$ C $ 31))+ 0.25 * D2/$ D $ 31 + 0.5 * E2/$ E $ 31」。相對和絕對引用

當宏代碼使用R [] C []格式並且行號不是靜態時,我如何處理絕對單元格值?

+0

您是否知道使用宏的相對參考? – pnuts 2015-02-05 22:01:40

回答

0

所以這裏是我一起炒的代碼。它不漂亮,但它的工作原理和做它應該做的事情。任何來自社區的格式提示都將不勝感激。

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 

我希望這可以幫助任何有類似問題的人。