[已解决]哪位大师能用VBA来解决这个问题

a316667229

在G3里输入512，用VBA自动搜索D2到D102里面那个是跟G3号码一样的，结果是D33和D2,这时G3的数据就是D34开始往下20个号码（黄色标签的)和从D3开始往下20个数据（绿色标志的）

最佳答案

月排行榜 / 总排行榜

蓝桥玄霜

2016-11-16 17:08

请见代码。

跳转到最佳答案楼层

望帝春心

完全看不懂

a316667229

望帝春心 发表于 2016-11-15 13:24
完全看不懂

在G3里输入512，用VBA自动搜索D2到D102里面那个是跟G3号码一样的，结果是D33和D2,这时G3的数据就是D34开始往下20个号码（黄色标签的)和从D3开始往下20个数据（绿色标志的）

蓝桥玄霜

请见代码。

a316667229

蓝桥玄霜 发表于 2016-11-16 17:08
请见代码。

老师，我按你的写的代码，怎么用不了，不知你可否给我一个代码



Sub lqxs()
Dim Arr, i&, x$, s$, j&
[g4].Resize(5000, 3).ClearContents
Arr = [a1].CurrentRegion
For j = 7 To UBound(Arr, 2)
    x = Arr(3, j): s = ""
    For i = 2 To UBound(Arr)
        If Arr(i, j - 3) = x Then s = s & i & ","
    NET
    If s <> "" Then
       s = Left(s, Len(s) - 1): n = 4
       If InStr(s, ",") Then
          aa = Split(s, ",")
          For y = UBound(aa) To 0 Step -1
              Cells(aa(y) + 1, j - 3).Resize(30, 1).Copy Cells(n, j): n = n + 30
          Next

      Else
         Cells(s + 1, j - 3).Resize(30, 1).Resize(30, 1).Copy Cells(n, j): n = n + 30
    End If
End If

Next
End Sub

a316667229

蓝桥玄霜 发表于 2016-11-16 17:08
请见代码。

你好大师，如果我增加了几列之后表格如图这样 那么我要在原先的VBA代码如何更改呢

原VBA代码是如下
Sub lqxs()
Dim Arr, i&, x$, s$, j&
[g4].Resize(5000, 3).ClearContents
Arr = [a1].CurrentRegion
For j = 7 To UBound(Arr, 2)
    x = Arr(3, j): s = ""
    For i = 2 To UBound(Arr)
        If Arr(i, j - 3) = x Then s = s & i & ","
    Next
    If s <> "" Then
       s = Left(s, Len(s) - 1): n = 4
       If InStr(s, ",") Then
          aa = Split(s, ",")
          For y = UBound(aa) To 0 Step -1
              Cells(aa(y) + 1, j - 3).Resize(30, 1).Copy Cells(n, j): n = n + 30
          Next

      Else
         Cells(s + 1, j - 3).Resize(30, 1).Resize(30, 1).Copy Cells(n, j): n = n + 30
    End If
End If

Next
End Sub

a316667229

蓝桥玄霜 发表于 2016-11-16 17:08
请见代码。

你好大师，如果是两个号码的要如何修改呢？之前你帮我解决的是三位数的，请给帮忙一下，教教我