单元格复制粘贴

wsxzaq147

这是一个请求查找的表格,A. B. C. D行由33个单元格组成,每行中每个单元格都是1--50自然数中任意1个数且不重复,要求在红色单元格内填上1----50自然数中任意1个数后:
1.点击"向右键",A行中符合红色格内数的数向右的整行复制并在A1行中以L8为起点粘贴,B行.C行.D行同理;
2.点击"向左键",A行中符合红色格内数的数向左的整行复制并在A1行中以AR13为起点粘贴,B行.C行.D行同理;
特别说明是要复制粘贴,我做了一个例表表达我的想法,谢谢!

guzhen9315

Public Arr(), Brr(), HH, BBB, LL
'-----------------------------
Sub 矩形8_单击()
    BBB = [M1]
    LL = 11
    For ii = 3 To 6
      Arr = Range("L" & ii & ":AR" & ii)
      Brr = Range("L" & ii + 5 & ":AQ" & ii + 6)
      HH = ii + 5
      Call GuGu
    Next ii
End Sub
'-----------------------------
Sub GuGu()
    For i = 1 To 33
        If BBB = Arr(1, i) Then
            For j = 33 + LL To 2 + LL Step -1
                Cells(HH, j) = Cells(HH, j - 1)
            Next j
            Cells(HH, 12) = BBB
        End If
    Next i
End Sub

guzhen9315

Sub 矩形9_单击()
    BBB = [M1]
    LL = 11
    For ii = 3 To 6
      Arr = Range("L" & ii & ":AR" & ii)
      Brr = Range("M" & ii + 10 & ":AR" & ii + 10)
      HH = ii + 10
      Call GuGuGu
    Next ii
End Sub
'---------------------------------
Sub GuGuGu()
    For i = 1 To 33
        If BBB = Arr(1, i) Then
            For j = 1 + LL To 32 + LL
                Cells(HH, j) = Cells(HH, j + 1)
            Next j
            Cells(HH, 33 + LL) = BBB
        End If
    Next i
End Sub

guzhen9315

信息收到。
以上VBA全部放在“模块3”里。

guzhen9315

LS查找.rar

guzhen9315

我想要的结果:
1..点击"向右键",A行中符合红色格内数的数向右的整行（指从和红格内的相同数起至AR这段所有单元格的数）复制(含这段内单元格内不同的颜色)并在A1行中以L8为起点粘贴,B行.C行.D行同理;
2.点击"向左键", A行中符合红色格内数的数向右的整行（指从和红格内的相同数起至L这段所有单元格的数）复制(含这段内单元格内不同的颜色)并在A2行中以AR13为起点粘贴,B行.C行.D行同理;

wsxzaq147

是这样,附件中有示例.

guzhen9315

Public Arr(), HH, BBB, LL
Sub 矩形8_单击()
    BBB = [M1]
    LL = 11
    For ii = 3 To 6
        Arr = Range("L" & ii & ":AR" & ii)
        Range("L" & ii + 5 & ":AR" & ii + 5).Clear
        HH = ii + 5
        For i = 1 To 33
            If BBB = Arr(1, i) Then
                For j = 1 + LL To 34 + LL - i
                    Cells(HH, j) = Cells(ii, i + j - 1)
                Next j
            End If
        Next i
    Next ii
End Sub

guzhen9315

Public Arr(), HH, BBB, LL
Sub 矩形8_单击()
    BBB = [M1]
    LL = 11
    For ii = 3 To 6
        Arr = Range("L" & ii & ":AR" & ii)
        Range("L" & ii + 5 & ":AR" & ii + 5).Clear
        HH = ii + 5
        For i = 1 To 33
            If BBB = Arr(1, i) Then
                For j = 1 + LL To 34 + LL - i
                    Cells(HH, j) = Cells(ii, i + j - 1)
                Next j
            End If
        Next i
    Next ii
End Sub
Sub 矩形9_单击()
    BBB = [M1]
    LL = 11
    For ii = 3 To 6
      Arr = Range("L" & ii & ":AR" & ii)
      Range("M" & ii + 10 & ":AR" & ii + 10).Clear
      HH = ii + 10
      For i = 1 To 33
            If BBB = Arr(1, i) Then
                For j = 33 + LL To 33 + LL - i - 1 Step -1
                    Cells(HH, j) = Cells(ii, i + j - 33)
                Next j
            End If
        Next i
    Next ii
End Sub

wsxzaq147

感谢你的帮助,很好用.但很怪,把程序中稍做改动(只修改了起始和终点位),就不能用了,不知怎么回事,另外若能把A B C D行中每个单元格不同的颜在A1 B1 C1 D1行及A2 B2 C2 D2行分别显出来就更好了.