类型不匹配，如何解决？

jackyava

Sub 凌空一羽()
Application.ScreenUpdating = False
For i = 3 To 65536
    '标题------------
    If i Mod 4 = 3 Then
        Range("bc" & i - 1 & ":be" & i - 1).Copy Cells(i - 1, "Aq")
        Range("bh" & i - 1 & ":bj" & i - 1).Copy Cells(i - 1, "At")
    End If
    '------------标题
   '内容------------
    If (i - 3) Mod 4 < 2 Then   '取前2个
        gi = Int((i + 1) / 4) * 4 - 1
        '执行只取唯一最小(大)值------------
        If Application.CountIf(Cells(gi, "aw").Resize(1, 3), "<1") = 1 Then
            gmin = Application.Min(Cells(gi, "aw").Resize(1, 3))
            gmc = Application.Match(gmin, Cells(gi, "aw").Resize(1, 3), 0)
        Else
            gmax = Application.Max(Cells(gi, "aw").Resize(1, 3))
            gmc = Application.Match(gmax, Cells(gi, "aw").Resize(1, 3), 0)
        End If
        '------------执行只取唯一最小(大)值
        For j = 1 To 6
            If j > 3 Then  '分2个区域选择值
                gb = Cells(i, "BG").Offset(0, gmc)
                If Cells(i, j + 56) = gb Then
                    Cells(i, j + 42) = "等于参照": Cells(i, j + 42).Interior.ColorIndex = 5: Cells(i, j + 42).Font.ColorIndex = 2: Cells(i, j + 42).Font.Bold = True  '颜色变化
                ElseIf Cells(i, j + 56) > gb Then
                    Cells(i, j + 42) = "大于参照": Cells(i, j + 42).Interior.ColorIndex = 3: Cells(i, j + 42).Font.ColorIndex = 6: Cells(i, j + 42).Font.Bold = True
                Else
                    Cells(i, j + 42) = "小于参照": Cells(i, j + 42).Interior.ColorIndex = 7: Cells(i, j + 42).Font.ColorIndex = 6: Cells(i, j + 42).Font.Bold = True
                End If
                If j - 3 = gmc Then Cells(i, j + 42) = "参照": Cells(i, j + 42).Interior.ColorIndex = 40: Cells(i, j + 42).Font.ColorIndex = 1: Cells(i, j + 42).Font.Bold = True
            Else
                ga = Cells(i, "BB").Offset(0, gmc)
                If Cells(i, j + 54) = ga Then
                    Cells(i, j + 42) = "等于参照": Cells(i, j + 42).Interior.ColorIndex = 5: Cells(i, j + 42).Font.ColorIndex = 2: Cells(i, j + 42).Font.Bold = True
                ElseIf Cells(i, j + 54) > ga Then
                    Cells(i, j + 42) = "大于参照": Cells(i, j + 42).Interior.ColorIndex = 3: Cells(i, j + 42).Font.ColorIndex = 6: Cells(i, j + 42).Font.Bold = True
                Else
                    Cells(i, j + 42) = "小于参照": Cells(i, j + 42).Interior.ColorIndex = 7: Cells(i, j + 42).Font.ColorIndex = 6: Cells(i, j + 42).Font.Bold = True
                End If
                If j = gmc Then Cells(i, j + 42) = "参照": Cells(i, j + 42).Interior.ColorIndex = 40: Cells(i, j + 42).Font.ColorIndex = 1: Cells(i, j + 42).Font.Bold = True
            End If
        Next
    End If
    '------------ 内容
Next
Application.ScreenUpdating = True
End Sub

附件
按条件比较数值大小（修改）.rar (13.73 KB, 下载次数: 2)

2017-5-14 12:57 上传

点击文件名下载附件

凌空一羽

1. Sub 比较大小()
   
2. Application.ScreenUpdating = False
   
3. For i = 3 To Range("bc10000").End(3).Row
   
4.     '标题------------
   
5.     If i Mod 4 = 3 Then
   
6.         Range("bc" & i - 1 & ":be" & i - 1).Copy Cells(i - 1, "Aq")
   
7.         Range("bh" & i - 1 & ":bj" & i - 1).Copy Cells(i - 1, "At")
   
8.     End If
   
9.     '------------标题
   
10.    '内容------------
    
11.     If (i - 3) Mod 4 < 2 Then   '取前2个
    
12.         gi = Int((i + 1) / 4) * 4 - 1
    
13.         '执行只取唯一最小(大)值------------
    
14.         If Application.CountIf(Cells(gi, "aw").Resize(1, 3), "<1") = 1 Then
    
15.             gmin = Application.Min(Cells(gi, "aw").Resize(1, 3))
    
16.             gmc = Application.Match(gmin, Cells(gi, "aw").Resize(1, 3), 0)
    
17.         Else
    
18.             gmax = Application.Max(Cells(gi, "aw").Resize(1, 3))
    
19.             gmc = Application.Match(gmax, Cells(gi, "aw").Resize(1, 3), 0)
    
20.         End If
    
21.         '------------执行只取唯一最小(大)值
    
22.         For j = 1 To 6
    
23.         Cells(i, j + 42).Font.Bold = True
    
24.             If j > 3 Then  '分2个区域选择值
    
25.                 gb = Cells(i, "BG").Offset(0, gmc)
    
26.                 If Cells(i, j + 56) = gb Then
    
27.                     Cells(i, j + 42) = "等于参照": Cells(i, j + 42).Interior.ColorIndex = 5: Cells(i, j + 42).Font.ColorIndex = 2   '颜色变化
    
28.                 ElseIf Cells(i, j + 56) > gb Then
    
29.                     Cells(i, j + 42) = "大于参照": Cells(i, j + 42).Interior.ColorIndex = 3: Cells(i, j + 42).Font.ColorIndex = 6
    
30.                 Else
    
31.                     Cells(i, j + 42) = "小于参照": Cells(i, j + 42).Interior.ColorIndex = 7: Cells(i, j + 42).Font.ColorIndex = 6
    
32.                 End If
    
33.                 If j - 3 = gmc Then Cells(i, j + 42) = "参照": Cells(i, j + 42).Interior.ColorIndex = 40: Cells(i, j + 42).Font.ColorIndex = 1
    
34.             Else
    
35.                 ga = Cells(i, "BB").Offset(0, gmc)
    
36.                 If Cells(i, j + 54) = ga Then
    
37.                     Cells(i, j + 42) = "等于参照": Cells(i, j + 42).Interior.ColorIndex = 5: Cells(i, j + 42).Font.ColorIndex = 2
    
38.                 ElseIf Cells(i, j + 54) > ga Then
    
39.                     Cells(i, j + 42) = "大于参照": Cells(i, j + 42).Interior.ColorIndex = 3: Cells(i, j + 42).Font.ColorIndex = 6
    
40.                 Else
    
41.                     Cells(i, j + 42) = "小于参照": Cells(i, j + 42).Interior.ColorIndex = 7: Cells(i, j + 42).Font.ColorIndex = 6:
    
42.                 End If
    
43.                 If j = gmc Then Cells(i, j + 42) = "参照": Cells(i, j + 42).Interior.ColorIndex = 40: Cells(i, j + 42).Font.ColorIndex = 1
    
44.             End If
    
45.         Next
    
46.     End If
    
47.     '------------ 内容
    
48. Next
    
49. Application.ScreenUpdating = True
    
50. End Sub

复制代码

jackyava

凌空一羽 发表于 2017-5-14 13:43

http://club.excelhome.net/thread-1345833-1-1.html
老师这个贴里的代码，速度可否改快些