请教有点复杂的复制--查找--粘贴，用程序怎么写？

gzminge

复制AA1：AB5，然后从最左边开始，查找第一个含有“123”的格子，进行数值粘贴。

复制AA6：AB15，查找第一个含有“456”的格子，进行粘贴（是全粘贴，不是数值粘贴）。

复制AA1：AB5，在A1:D15中从左至右，查找第一个空白的格子，进行粘贴。

复制AA6：AB15，在A1:D15中查找从左至右第2个空格，从上到下第4个空格，进行数值粘贴。

复制AA1：AB5，在A1:G15中查找从左至右第1个含有“123”的格子，从上到下第2个含有“123”的格子，进行数值粘贴。

复制AA6：AB15，在A1:G15中查找从左至右第2个含有“456”的格子，从上到下第1个含有“456”的格子，进行粘贴。




复制AA1：AB5，在H1:J15中查找从左至右第1个含有“123”的格子，从上到下第3个含有“123”的格子，进行粘贴。

复制AA6：AB15，在H1:J15中查找从左至右第1个含有“456”的格子，从上到下第5个含有“456”的格子，进行粘贴。



新建 XLSX 工作表.rar (8.83 KB, 下载次数: 1)

2024-8-21 20:27 上传

点击文件名下载附件

gzminge

请各位老师指教

扇扇扇

这个需求在工作中干什么用的

扇扇扇

扇扇扇

扇扇扇 发表于 2024-8-22 13:46

总感觉有点问题

gzminge

扇扇扇 发表于 2024-8-22 13:50
总感觉有点问题

谢谢，先下载来看看

gzminge

扇扇扇 发表于 2024-8-22 13:50
总感觉有点问题

大哥好，请教以下的这些设定是什么含义，谢谢：

Dim a, ar, arr, br, brr
Dim r As Range, rg As Range
Dim i%, j%, n%, n1%
Dim s1, s2, t

Application.ScreenUpdating = False
Application.DisplayAlerts = False
t = Timer: s1 = 123: s2 = 456
Set r = [AA1:AB5]: Set rg = [AA6:AB15]
a = [A1:J15]
b = [AA1:AB5].Value: br = [AA6:AB15].Value

gzminge

扇扇扇 发表于 2024-8-22 13:50
总感觉有点问题

大哥好，还有下面的内容，能详细讲解吗？谢谢：
round4:
ar = [A1:D15]
For i = 1 To UBound(ar)
    For j = 1 To UBound(ar, 2)
        If ar(i, j) = "" Then
            n = n + 1
        End If
        If n = 2 Then
        GoTo round41
        End If
    Next
Next
round41:
ar = [A1:D15]
For i = i + 1 To UBound(ar)
    If ar(i, j) = "" Then
    n1 = n1 + 1
        If n1 = 3 Then
        Cells(i, j).Resize(UBound(br), UBound(br, 2)) = br
        GoTo round5
        End If
    End If
Next
round5:
arr = [A1:G15]
For i = 1 To UBound(arr)
    For j = 1 To UBound(arr, 2)
        If arr(i, j) = s1 Then
            GoTo round51
        End If
    Next
Next
round51:
For i = i + 1 To UBound(arr)
    If arr(i, j) = s1 Then
        Cells(i, j).Resize(UBound(b), UBound(b, 2)) = b
        GoTo round6
    End If
Next

gzminge

扇扇扇 发表于 2024-8-22 13:50
总感觉有点问题

老师早上好，你写的程序很好用。但是我学习了一个晚上都没有学会，请你一点点的详细讲解一下可以吗？谢谢！

赵桢0611

Sub test()    '子程序 test()
    Dim a, ar, arr, br, brr    '定义变量 a,ar,arr,br,brr
    Dim r As Range, rg As Range    '定义变量 r 为 单元格区域,rg 为 单元格区域
    Dim i%, j%, n%, n1%    '定义变量 i%,j%,n%,n1%
    Dim s1, s2, t    '定义变量 s1,s2,t
    Application.ScreenUpdating = False    '关闭屏幕刷新(可以提高运行速度)
    Application.DisplayAlerts = False    '关闭警告信息显示
    t = Timer: s1 = 123: s2 = 456    't=当前计时: s1=123:s2=456
    Set r = [AA1:AB5]: Set rg = [AA6:AB15]    '设定 r=[AA1:AB5]:设定rg=[AA6:AB15]
    a = [A1:J15]    ' a=[A1:J15]
    b = [AA1:AB5].Value: br = [AA6:AB15].Value    'b=[AA1 :AB5]的值:br=[AA6 :AB15]的值
    For i = 1 To UBound(a)    '设定变量范围为i=1到<数组上限>(a)
        For j = 1 To UBound(a, 2)    '设定变量范围为j=1到<数组上限>(a,2)
            If a(i, j) = s1 Then    '如果 a(i,j)=s1 则执行
            Cells(i, j).Resize(UBound(b), UBound(b, 2)) = b    '<单元格坐标>(i,j )的<重调大小>(<数组上限>(b),<数组上限>(b,2))=b
            GoTo round2    ' 跳至 round2
        End If    'If判断过程结束
    Next    '下一个
Next    '下一个
round2:    'round2:
a = [A1:J15]    'a=[A1:J15]
For i = 1 To UBound(a)    '设定变量范围为i=1到<数组上限>(a)
    For j = 1 To UBound(a, 2)    '设定变量范围为j=1到<数组上限>(a,2)
        If a(i, j) = s2 Then    '如果 a(i,j)=s2 则执行
        rg.Copy Cells(i, j)    ' rg的复制  <单元格坐标>(i,j)
        GoTo round3    ' 跳至 round3
    End If    'If判断过程结束
Next    '下一个
Next    '下一个
round3:    'round3:
ar = [A1:D15]    'ar=[A1:D15]
For i = 1 To UBound(ar)    '设定变量范围为i=1到<数组上限>(ar)
    For j = 1 To UBound(ar, 2)    '设定变量范围为j=1到<数组上限>(ar,2)
        If ar(i, j) = "" Then    '如果 ar(i,j)=空值 则执行
        r.Copy Cells(i, j)    ' r的复制  <单元格坐标>(i,j)
        GoTo round4    ' 跳至 round4
    End If    'If判断过程结束
Next    '下一个
Next    '下一个
round4:    'round4:
ar = [A1:D15]    'ar=[A1:D15]
For i = 1 To UBound(ar)    '设定变量范围为i=1到<数组上限>(ar)
    For j = 1 To UBound(ar, 2)    '设定变量范围为j=1到<数组上限>(ar,2)
        If ar(i, j) = "" Then    '如果 ar(i,j)=空值 则执行
        n = n + 1    'n=n+1
    End If    'If判断过程结束
    If n = 2 Then    '如果 n=2 则执行
    GoTo round41    ' 跳至 round41
End If    'If判断过程结束
Next    '下一个
Next    '下一个
round41:    'round41:
ar = [A1:D15]    'ar=[A1:D15]
For i = i + 1 To UBound(ar)    '设定变量范围为i=i+1到<数组上限>(ar)
    If ar(i, j) = "" Then    '如果 ar(i,j)=空值 则执行
    n1 = n1 + 1    'n1=n1+1
    If n1 = 3 Then    '如果 n1=3 则执行
    Cells(i, j).Resize(UBound(br), UBound(br, 2)) = br    '<单元格坐标>(i,j )的<重调大小>(<数组上限>(br),<数组上限>(br,2))=br
    GoTo round5    ' 跳至 round5
End If    'If判断过程结束
End If    'If判断过程结束
Next    '下一个
round5:    'round5:
arr = [A1:G15]    'arr=[A1:G15]
For i = 1 To UBound(arr)    '设定变量范围为i=1到<数组上限>(arr)
    For j = 1 To UBound(arr, 2)    '设定变量范围为j=1到<数组上限>(arr,2)
        If arr(i, j) = s1 Then    '如果 arr(i,j)=s1 则执行
        GoTo round51    ' 跳至 round51
    End If    'If判断过程结束
Next    '下一个
Next    '下一个
round51:    'round51:
For i = i + 1 To UBound(arr)    '设定变量范围为i=i+1到<数组上限>(arr)
    If arr(i, j) = s1 Then    '如果 arr(i,j)=s1 则执行
    Cells(i, j).Resize(UBound(b), UBound(b, 2)) = b    '<单元格坐标>(i,j )的<重调大小>(<数组上限>(b),<数组上限>(b,2))=b
    GoTo round6    ' 跳至 round6
End If    'If判断过程结束
Next    '下一个
round6:    'round6:
arr = [A1:G15]    'arr=[A1:G15]
n = 0    'n=0
For i = 1 To UBound(arr)    '设定变量范围为i=1到<数组上限>(arr)
    For j = 1 To UBound(arr, 2)    '设定变量范围为j=1到<数组上限>(arr,2)
        If arr(i, j) = s2 Then    '如果 arr(i,j)=s2 则执行
        n = n + 1    'n=n+1
        If n = 2 Then    '如果 n=2 则执行
        GoTo round61    ' 跳至 round61
    End If    'If判断过程结束
End If    'If判断过程结束
Next    '下一个
Next    '下一个
round61:    'round61:
For i = i To UBound(arr)    '设定变量范围为i=i到<数组上限>(arr)
    If arr(i, j) = s2 Then    '如果 arr(i,j)=s2 则执行
    rg.Copy Cells(i, j)    ' rg的复制  <单元格坐标>(i,j)
    GoTo round7    ' 跳至 round7
End If    'If判断过程结束
Next    '下一个
round7:    'round7:
brr = [H1:J15]    'brr=[H1:J15]
For i = 1 To UBound(brr)    '设定变量范围为i=1到<数组上限>(brr)
    For j = 1 To UBound(brr, 2)    '设定变量范围为j=1到<数组上限>(brr,2)
        If brr(i, j) = s1 Then    '如果 brr(i,j)=s1 则执行
        GoTo round71    ' 跳至 round71
    End If    'If判断过程结束
Next    '下一个
Next    '下一个
round71:    'round71:
n = 0    'n=0
For i = i + 1 To UBound(brr)    '设定变量范围为i=i+1到<数组上限>(brr)
    If brr(i, j) = s1 Then    '如果 brr(i,j)=s1 则执行
    n = n + 1    'n=n+1
    If n = 2 Then    '如果 n=2 则执行
    r.Copy Cells(i, j + UBound(arr, 2))    ' r的复制  <单元格坐标>(i,j+<数组上限>(arr,2))
    GoTo round8    ' 跳至 round8
End If    'If判断过程结束
End If    'If判断过程结束
Next    '下一个
round8:    'round8:
brr = [H1:J15]    'brr=[H1:J15]
For i = 1 To UBound(brr)    '设定变量范围为i=1到<数组上限>(brr)
    For j = 1 To UBound(brr, 2)    '设定变量范围为j=1到<数组上限>(brr,2)
        If brr(i, j) = s2 Then    '如果 brr(i,j)=s2 则执行
        GoTo round81    ' 跳至 round81
    End If    'If判断过程结束
Next    '下一个
Next    '下一个
round81:    'round81:
n = 0    'n=0
For i = i + 1 To UBound(brr)    '设定变量范围为i=i+1到<数组上限>(brr)
    If brr(i, j) = s2 Then    '如果 brr(i,j)=s2 则执行
    n = n + 1    'n=n+1
    If n = 4 Then    '如果 n=4 则执行
    rg.Copy Cells(i, j + UBound(arr, 2))    ' rg的复制  <单元格坐标>(i,j+<数组上限>(arr,2))
    GoTo ok    ' 跳至 ok
End If    'If判断过程结束
End If    'If判断过程结束
Next    '下一个
ok:    'ok:
Application.ScreenUpdating = True    '开启屏幕刷新
Application.DisplayAlerts = True    '开启警告信息显示
MsgBox "用时" & Format(Timer - t, "0.00" & "秒")    '<消息框>："用时" & 格式化字符串(当前计时-t,"0.00" & "秒")
End Sub    '子程序结束