检查配方表原料是否按降序排列

山海风云轩

求助，检查配方表中的原料是否按D列的数值降序排序，具体需求见附件

山海风云轩

顶上去啊，有大佬在吗

山海风云轩

自己写了一个，还不够完善，抛砖引玉，请大佬帮忙看看

Sub 降序审核()
Dim i, s, a
   
    For i = Range("d1000").End(3).Row To 3 Step -1
   
    If Cells(i, 4).Value > Cells(i - 1, 4).Value And Cells(i - 1, 4) <> "" Then
   
   Cells(i, 4).Interior.ThemeColor = 8
  
    Cells(i, 4).Font.Color = 255
   
    ' s = s & vbCrLf & Cells(i, 4).Address & "号原料含量排序不对；"
      
   
     End If
    Next i
   
  ' If s <> "" Then MsgBox Cells(i, 4).Address & "号原料含量排序不对；"
  '  Set s = Nothing
   
    For i = 3 To Range("d1000").End(3).Row
       With Cells(i, 4)
           If .MergeArea(1).Address = .Address Then
               N = N + 1
                If .Value = "" Then
               
                 Cells(i, 4).Interior.ThemeColor = 8
                    a = a & vbCrLf & "第" & N & "号原料含量为空；"
           
                    a = a & vbCrLf & "第" & Cells(i, 4).Address & "号原料含量排序不对；"
                End If
                 
           End If
       End With
   
   Next i

   
    If a <> "" Then
    MsgBox a & vbCrLf & "请核对！"
   
    Set a = Nothing
    End If
      
End Sub

山海风云轩

自己写了一个，不够完善，抛砖引玉，请大佬帮忙看看
Sub 降序审核()
Dim i, s, a
   
    For i = Range("d1000").End(3).Row To 3 Step -1
   
    If Cells(i, 4).Value > Cells(i - 1, 4).Value And Cells(i - 1, 4) <> "" Then
   
   Cells(i, 4).Interior.ThemeColor = 8
  
    Cells(i, 4).Font.Color = 255
   
    ' s = s & vbCrLf & Cells(i, 4).Address & "号原料含量排序不对；"
      
   
     End If
    Next i
   
  ' If s <> "" Then MsgBox Cells(i, 4).Address & "号原料含量排序不对；"
  '  Set s = Nothing
   
    For i = 3 To Range("d1000").End(3).Row
       With Cells(i, 4)
           If .MergeArea(1).Address = .Address Then
               N = N + 1
                If .Value = "" Then
               
                 Cells(i, 4).Interior.ThemeColor = 8
                    a = a & vbCrLf & "第" & N & "号原料含量为空；"
           
                    a = a & vbCrLf & "第" & Cells(i, 4).Address & "号原料含量排序不对；"
                End If
                 
           End If
       End With
   
   Next i

   
    If a <> "" Then
    MsgBox a & vbCrLf & "请核对！"
   
    Set a = Nothing
    End If
      
End Sub

山海风云轩

自己写了一个，不够完善，抛砖引玉，请大佬帮忙看看