如何将两列间隔的相同项目的数据，根据条件引用至另外一列

huacuo1118

如何实现  J K L列的数据自动引用填充，求求各位大神啦，大神们最靓了

1055751654

示例图3-203不对吧

问山

单位＝INDIRECT(TEXT(SMALL(IF($J$1=$C$3:$F$12,1+ROW($3:$12)*100,9^6),ROW(A1)),"R00C00"),0)&""
业绩比例、业绩金额＝INDIRECT(TEXT(SMALL(IF($J$1=$C$3:$F$12,COLUMN(D:G)+ROW($3:$12)*100,9^6),ROW(A1)),"R00C00"),0)&""下拉右拉

solextrade

示例22.rar (10.19 KB, 下载次数: 15)

2019-11-4 17:06 上传

点击文件名下载附件

1055751654

Sub 傻不愣登的代码()
Dim arr, i, b, brr(1 To 100, 1 To 3)
arr = Range("a1").CurrentRegion
For i = 3 To UBound(arr)
If Cells(i, 3) Like "*张三*" Then
    b = b + 1
     brr(b, 1) = arr(i, 1)
     brr(b, 2) = arr(i, 4)
     brr(b, 3) = arr(i, 5)
  End If
  If Cells(i, 6) Like "*张三*" Then
     b = b + 1
     brr(b, 1) = arr(i, 1)
     brr(b, 2) = arr(i, 7)
     brr(b, 3) = arr(i, 8)
  End If
Next
[j3].Resize(b, 3) = brr
End Sub

huacuo1118

谢谢各位大佬的帮忙，简直太强大了

huacuo1118

solextrade 发表于 2019-11-4 17:07

非常完美，完全实现，太感谢了，这个公式值得我好好学习一段时间了

...行数多了之后，单位编号就出错了，把不想干的也引用进来了，能不能再帮看一下

huacuo1118

问山 发表于 2019-11-4 16:44
单位＝INDIRECT(TEXT(SMALL(IF($J$1=$C$3:$F$12,1+ROW($3:$12)*100,9^6),ROW(A1)),"R00C00"),0)&""
业绩比 ...

这个公式我复制后显示#VALUE,数组之后显示空格，不过还是非常感谢大神的帮忙，非常感谢！！！

huacuo1118

1055751654 发表于 2019-11-4 19:29
Sub 傻不愣登的代码()
Dim arr, i, b, brr(1 To 100, 1 To 3)
arr = Range("a1").CurrentRegion

代码太厉害了，会写打码的都是牛人啊，非常感谢

1055751654

huacuo1118 发表于 2019-11-4 19:49
代码太厉害了，会写打码的都是牛人啊，非常感谢

不厉害，我想一下把李四王二麻子也弄出来，弄出来了，虽然代码打的烂，但也要保持S形的身材
Sub 傻不愣登的代码()
Dim arr, i, b, brr(1 To 100, 1 To 3), bb, xx
[j3:r100].ClearContents
arr = Range("a1").CurrentRegion
For i = 3 To UBound(arr)
  If Cells(i, 3) Like "*张三*" Then
    b = b + 1
     brr(b, 1) = arr(i, 1)
      brr(b, 2) = arr(i, 4)
       brr(b, 3) = arr(i, 5)
        End If
         If Cells(i, 6) Like "*张三*" Then
         b = b + 1
         brr(b, 1) = arr(i, 1)
        brr(b, 2) = arr(i, 7)
     brr(b, 3) = arr(i, 8)
  End If
Next
[j3].Resize(b, 3) = brr
   For i = 3 To UBound(arr)
    If Cells(i, 3) Like "*李四*" Then
     bb = bb + 1
      brr(bb, 1) = arr(i, 1)
       brr(bb, 2) = arr(i, 4)
        brr(bb, 3) = arr(i, 5)
         End If
        If Cells(i, 6) Like "*李四*" Then
       bb = bb + 1
      brr(bb, 1) = arr(i, 1)
     brr(bb, 2) = arr(i, 7)
    brr(bb, 3) = arr(i, 8)
  End If
Next
[m3].Resize(bb, 3) = brr
  For i = 3 To UBound(arr)
   If Cells(i, 3) Like "*王二麻子*" Then
    xx = xx + 1
     brr(xx, 1) = arr(i, 1)
      brr(xx, 2) = arr(i, 4)
       brr(xx, 3) = arr(i, 5)
        End If
       If Cells(i, 6) Like "*王二麻子*" Then
      xx = xx + 1
     brr(xx, 1) = arr(i, 1)
    brr(xx, 2) = arr(i, 7)
   brr(xx, 3) = arr(i, 8)
  End If
Next
[p3].Resize(xx, 3) = brr
End Sub