求一个find循环查找的代码，请高手帮忙

yellow777 · 发表于 2016-1-13 15:49

实例如下，aaaaa不定行出现，想把每段aaaaa和下个aaaaa之前的内容复制新表中，我思路是用find查找取两个Ｒow进行行选复制至新表，其中涉及到循环，基础差一直没弄成，请高手帮写段代码
，先谢了

aaaaa
1
2
3
4
5
6
aaaaa
1
2
3
aaaaa
1
3
4
5
6
7
aaaaa
1
3
4
5
6
7
8

zhaogang1960 · 发表于 2016-1-13 17:02

请参考：

Sub Macro1()
Dim c As Range, r As Range, firstAddress$, i&, m&
m = [a65536].End(xlUp).Row + 1
With Range("a:a")
Set c = .Find("aaaaa", Cells(Rows.Count, 1), , 1)
If Not c Is Nothing Then
firstAddress = c.Address
Do
i = i + 1
Set r = c.Offset(1).Resize(m).Find("aaaaa", , , 1)
If Not r Is Nothing Then
c.Resize(r.Row - c.Row).Copy Cells(1, i + 13)
Else
c.Resize(m - c.Row).Copy Cells(1, i + 13)
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub

复制代码

zhaogang1960 · 发表于 2016-1-13 17:05

aaaaa及下面的数字复制到N、O……列，请测试附件

求代码.rar (7.56 KB, 下载次数: 55)

yeminqiang · 发表于 2016-1-13 17:41

Sub ttt()
Dim i&, k&, m&
k = 1
m = 2
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 1) <> "aaaaa" Then
k = k + 1
Cells(1, m) = "aaaa"
Cells(k, m) = Cells(i, 1)
Else
k = 1
m = m + 1
End If
Next
End Sub

复制代码

yeminqiang · 发表于 2016-1-13 17:43

求代码.zip (13.84 KB, 下载次数: 39)
补充一个，请参考

yellow777 · 发表于 2016-1-13 18:35

谢谢，两位老师的帮忙，太谢谢了，你们的代码都实现了，不是很懂。。多种嵌套，我一看就晕，我结合我的问题我试一下，再谢了

hgjian1985 · 发表于 2016-1-13 18:48

zhaogang1960 发表于 2016-1-13 17:02
请参考：

请问发帖子贴代码怎么样才可以贴出你这样的效果啊？就是带上行号这样的

zhangcheng6688 · 发表于 2018-10-11 13:22

zhaogang1960 发表于 2016-1-13 17:02
请参考：

版主在嘛？请教一个问题，.Find("aaaaa", Cells(Rows.Count, 1), , 1)方法里面what:="aaaaa",after:=Cells(Rows.Count, 1),lookin省略，lookat:=1,1具体代表哪个参数，是xlwhole还是xlpart??
参数顺序是不是这样的

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

[求助] 求一个find循环查找的代码，请高手帮忙

评分