[已解决]求助VBA

GYUHJ · 发表于 2012-5-10 18:18

Book1.rar (8.58 KB, 下载次数: 3)

zjdh · 发表于 2012-5-10 18:45

N15到T列里面的空列里
V15到AA列里面的空列里
怎么解释？？！！

GYUHJ · 发表于 2012-5-10 18:50

zjdh 发表于 2012-5-10 18:45
N15到T列里面的空列里
V15到AA列里面的空列里
怎么解释？？！！

在规定的区域列里哪列没有数据就放哪列.

GYUHJ · 发表于 2012-5-10 19:20

zjdh 发表于 2012-5-10 18:45
N15到T列里面的空列里
V15到AA列里面的空列里
怎么解释？？！！

是不是没有说清楚?

zjdh · 发表于 2012-5-10 19:23

筛选数据2.rar (13.54 KB, 下载次数: 6)

GYUHJ · 发表于 2012-5-10 19:32

zjdh 发表于 2012-5-10 19:23

结果只放N15到T列里面的空列里的一列里面
V15到AA列也一样

zjdh · 发表于 2012-5-10 19:37

这还简单多了。

筛选数据3.rar (12.33 KB, 下载次数: 15)

GYUHJ · 发表于 2012-5-10 19:54

zjdh 发表于 2012-5-10 19:37
这还简单多了。

我还是没有说清楚,1,不能清除掉N14到AA列里的数据,它只能寻找规定列里的空列放,例第一次运行放N列,第二次运行就是放O列

GYUHJ · 发表于 2012-5-10 20:09

zjdh 发表于 2012-5-10 19:37
这还简单多了。

我不懂,找了相似代码的意思

                                          Next
                                          With Sheets(1)
                                          k = .Range("T15").End(xlToLeft).Column
                                          If k < 14 Then
                                          k = 14
                                          Else
                                          k = k + 1

zjdh · 发表于 2012-5-10 20:49

GYUHJ 发表于 2012-5-10 20:09
我不懂,找了相似代码的意思

                        ...

也可以啊：
Sub test()
Dim B1(), B2(), BRR(), CRR()
Set D = CreateObject("scripting.dictionary")
For I = 1 To 4
      ARR = Sheets(I).Range("D15:D40")
      For J = 1 To UBound(ARR)
         If ARR(J, 1) <> "" Then
            If Not D.exists(ARR(J, 1)) Then
                  D.Add ARR(J, 1), 1
            Else
                  D(ARR(J, 1)) = D(ARR(J, 1)) + 1
            End If
         End If
      Next
Next
K = D.keys
For I = 0 To UBound(K)
      If D(K(I)) > 2 And D(K(I)) < 7 Then
         N1 = N1 + 1
         ReDim Preserve B1(1 To N1)
         B1(N1) = K(I)
      End If
      If D(K(I)) > 0 And D(K(I)) < 5 Then
         N2 = N2 + 1
         ReDim Preserve B2(1 To N2)
         B2(N2) = K(I)
      End If
Next
C1 = Range("T15").End(1).Column
If C1 < 14 Then
      C1 = 14
Else
      C1 = C1 + 1
End If
C2 = Range("AA15").End(1).Column
If C2 < 22 Then
      C2 = 22
Else
      C2 = C2 + 1
End If
Cells(15, C1).Resize(N1, 1) = Application.Transpose(B1)
Cells(15, C2).Resize(N2, 1) = Application.Transpose(B2)
End Sub

		自动登录	找回密码
密码			注册