創建一個宏來比較同一工作表中不同列的單元格值

Question

我試圖做一個宏，它將以系統方式比較單元格值。 我有2個數據集。我打算創建的宏基本上會將「C3：M25」的值與「O3：Y25」的值進行比較。

我的宏應該開始比較範圍（「C3」）中的值和範圍（「O3」）。 如果C3.value> O3.value，它會改變interior.colourindex.value和字體顏色

一旦與第一比較完成的，它會下來即 比較範圍內移動到下一行（ 「C4」）。範圍（「O4」）。該過程繼續進行，直到它遇到列中的第一個空白行，在此情況下爲Range（「C26」）。

一旦範圍（「C26」）是一個空單元格，然後 宏將重複比較過程，但是這次它將基本上將範圍（「D3」）中的值與範圍（「P3」）進行比較。循環一直持續到整個過程完成。

Sub ilovetocompare() 

Dim ross As Long, colss As Long 
Dim wb As Workbook, ws1 As Long, ws1row As Integer 



Set wb = ActiveWorkbook.Sheets("Pricer") 
wb.Range("C3").Activate 
With ActiveCell 
ws1row = Worksheets("pricer").Range("B3").End(xlDown).Rows.Count 
'get the last row count 


'macro will stop when it detects that the cells is filled with other colors 

Do Until ActiveCell.Interior.Color = 255 

'start comparing the prices 
For ross = 3 To ws1row 
For colss = 15 To 25 ' number of columns will remain unchanged 

If ActiveCell.Value > Cells(ross, colss).Value Then 

ActiveCell.Font.Bold = True 
ActiveCell.Font.colour = vbWhite 
'once done with comparison, jump to the next row 
ActiveCell.Offset(1, 0).Activate 
'the column O likewise also move 1 row down for comparison 

Next ross 

'when the it hits an empty row, the activecell got readjusted back to the top 
ElseIf ActiveCell.Value = "" Then 
ActiveCell.Offset(-ws1row, 1).Select 
With Selection 
Loop 
'move the cell up again so that i can resume the comparsion 

'create this into a loop 




End Sub 

Answer 1

這裏建議：！也許是我的一部分

Private Sub macrobygiada() 
ColumnoneStart = 3 ' C 
ColumnoneEnd = 13 'M 
ColumntwoStart = 15 'O 

Set wb = ActiveWorkbook.Sheets("Pricer") 

TotalColumn = ColumnoneEnd - ColumnoneStart 'difference of the columnnumber C to M (3 to 13) 
For Column = 1 To TotalColumn 'number of columns 
    For Cell = 3 To 25 'go through the Cells 
     If (Cells(Cell, ColumnoneStart).Value > Cells(Cell, ColumntwoStart).Value) Then 
      wb.Cells(Cell, ColumnoneStart).Font.Bold = True 
      wb.Cells(Cell, ColumnoneStart).Font.ColorIndex = 2 'colour white 
     End If 
    Next 
ColumnoneStart = ColumnoneStart + 1 
ColumntwoStart = ColumntwoStart + 1 
Next 
Set wb = Nothing 
End Sub 

問候