求大师帮我把代码简写一下

838833928

简写代码                                    

liulang0808

红色代码部分，替换下面的，供参考
r = 16
   For j = 21 To 44
    If Sheet3.Cells(j, 11) = "留" Then
        r = r + 5
        For i = r To r + 4
            Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '-※-1
        Next i
    End If
   Next j
   
   
    For i = 21 To 25
        If Sheet3.Cells(21, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '-※-1
    Next
    For i = 26 To 29
        If Sheet3.Cells(22, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '2
    Next
    For i = 30 To 33
        If Sheet3.Cells(23, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '3
    Next
    For i = 34 To 37
        If Sheet3.Cells(24, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '4
    Next
    For i = 38 To 41
        If Sheet3.Cells(25, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '5
    Next
    For i = 42 To 45
        If Sheet3.Cells(26, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '6
    Next
    For i = 46 To 49
        If Sheet3.Cells(27, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '7
    Next
    For i = 50 To 54
        If Sheet3.Cells(28, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '-※-8
    Next
    For i = 55 To 58
        If Sheet3.Cells(29, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '9
    Next
    For i = 59 To 62
        If Sheet3.Cells(30, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '10
    Next
    For i = 63 To 66
        If Sheet3.Cells(31, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '11
    Next
    For i = 67 To 70
        If Sheet3.Cells(32, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '12
    Next
    For i = 71 To 74
        If Sheet3.Cells(33, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '13
    Next
    For i = 75 To 78
        If Sheet3.Cells(34, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '14
    Next
    For i = 79 To 82
        If Sheet3.Cells(35, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '15
    Next
    For i = 83 To 86
        If Sheet3.Cells(36, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '16
    Next
    For i = 87 To 91
        If Sheet3.Cells(37, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '-※-17
    Next
    For i = 92 To 95
        If Sheet3.Cells(38, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '18
    Next
    For i = 96 To 99
        If Sheet3.Cells(39, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '19
    Next
    For i = 100 To 103
        If Sheet3.Cells(40, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '20
    Next
    For i = 104 To 107
        If Sheet3.Cells(41, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '21
    Next
    For i = 108 To 111
        If Sheet3.Cells(42, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '22
    Next
    For i = 112 To 115
        If Sheet3.Cells(43, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '23
    Next
    For i = 116 To 120
        If Sheet3.Cells(44, 11) = "留" Then Cells(i, 31).Value = Sheet2.Cells(i, "D").Value '-※-24
    Next

yjh_27

1. r = 16
   
2. For j = 21 To 44
   
3.     If Sheet3.Cells(j, 11) = "留" Then
   
4.         r = r + 5
   
5.         Cells(r, 31).Resize(5, 1).Value = Sheet2.Cells(r, "D").Resize(5, 1).Value '-※-1
   
6.     End If
   
7. Next j
   

复制代码

cjjhpc

仅供参考
筛选.zip (122.4 KB, 下载次数: 11)

2021-5-11 07:39 上传

点击文件名下载附件

838833928

cjjhpc 发表于 2021-5-11 07:39
仅供参考

结果 不对啊，，排序是对的

838833928

liulang0808 发表于 2021-5-11 07:08
红色代码部分，替换下面的，供参考
r = 16
   For j = 21 To 44

老大，，结果不对喃

melville

为什么有时候会5个循环，有时候是4个循环？这个位置是有规律的吗？

山菊花

Sub 盘口()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Range("ae21:an999").ClearContents
    For k = 11 To 20
        r = 21
        For j = 21 To 44
            r2 = r + IIf(r = 21 Or r = 50 Or r = 87 Or r = 116, 4, 3)
            If Sheet3.Cells(j, k) = "留" Then
                For i = r To r2
                    Cells(i, k + 20).Value = Sheet2.Cells(i, "D").Value
                Next i
            End If
            r = r2 + 1
        Next j
        Cells(21, k + 20).Resize(r - 21, 1).Sort key1:=Cells(21, k + 20), order1:=xlAscending
    Next
   
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
   
End Sub

cjjhpc

这样该试试
Sub 盘口模拟()
    Dim i&, j&, k%, 结果
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    For i = 31 To 38
        Cells(19, i) = sheet1.Cells(19, i)
        With Range(Cells(21, i), Cells(1020, i))
            .ClearContents
            .NumberFormatLocal = "@"
        End With
    Next
    j = 21
    For k = 11 To 20
        For i = 21 To 120
            If Sheet3.Cells(j, k) = "留" Then Cells(i, k + 20) = Sheet2.Cells(i, 4)
            j = j + 1
        Next
        j = 21
    Next
    For i = 31 To 40
        Range(Cells(21, i), Cells(1020, i)).Sort key1:=Cells(21, i), order1:=xlAscending
    Next
    Range("BA21:BA2021").ClearContents '重置选取
    For 结果 = 21 To Sheet2.Range("B2021").End(3).Row + 1
         Cells(19, "BA") = "结果"
    With Cells(结果, "BA")
        .NumberFormatLocal = "@"
        .Value = Application.HLookup(Sheet3.Cells(11, "AS"), Range("AE19:AN" & Sheet2.Range("B2021").End(3).Row + 1), 结果 - 18, False)
    End With
    Next
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

838833928

山菊花 发表于 2021-5-11 10:35
r = 21
    For j = 21 To 44
        If Sheet3.Cells(j, 11) = "留" Then

大佬，，不好意思，，结果还是不对