根据特定的条件将行移动到另一行的末尾

我的工作表有不同数量的行。 列从A到R，基本上包含名称和地址。 在客户端名称中包含共同签名者，可以从10变为不同。我需要将共同签署者（1）行移动到客户端行的末尾。 如果客户端包含多个Cosigner，则下一个共同签名者（2）行将被移动到共同签名者（1）信息的末尾。 我可以得到第一个工作，但不知道如何循环通过工作表，并获得所有的共同签署者在正确的客户端行。 这是我迄今为止。 例

CLIENT# FIRST NAME LAST NAME DEBT_SSN STREET 00001 MICKEY MOUSE 000-00-0000 Address Number 1 (CS) DONALD DUCK 000-00-0001 Address Number 2 00002 MINNIE MOUSE 000-00-0002 Address Number 3 (CS) DAFFEY DUCK 000-00-0003 Address Number 4 (CS) BARNIE RUBBEL 000-00-0004 Address Number 5 

在这个例子中，（CS）唐老鸭的信息将被移动到第2行的列S到AI（CS），Daffey Duck将移动到第4行的列S到AI。 然后（CS）Barnie Rubbel将移动到第4排AJ到AZ。

 Sub MOVECS() Dim Rng As Range Set Rng = Range("B2:B6000").Find(What:="*(CS)*", LookAt:=xlWhole, _ LookIn:=xlValues) Rng.Resize(1, 17).Cut Rows(1).End(xlDown).Offset(0, 18) End Sub 

我试图添加一个“Nxt Rng”，但是会把我最后的（CS）logging移到第二行。

Answer 1

这是我的解决scheme：

  Sub append_cs_to_end_of_rows() 'once cs row is appended to end of client row, it deletes the source cs row r = 2 num_columns = 17 'this is the number of columns in the cs rows. would need to add one to it to get the number of columns in the client rows. Do While Not IsEmpty(Range("b" & r)) client_r = r r = r + 1 cur_offset = num_columns Do While IsEmpty(Range("a" & r)) And Not IsEmpty(Range("b" & r)) For c = 2 To 1 + num_columns Cells(client_r, c + cur_offset).Value = Cells(r, c).Value Next c Rows(r).Delete shift:=xlUp cur_offset = cur_offset + num_columns Loop Loop End Sub 

我避免使用复制/粘贴或剪切，因为这两个都需要范围，并且很难增加没有num_to_col函数的列。

请注意，列数是最大的，所以每个客户端的cs不能太多。 如果每个客户端保持在900以下，则应该可以（假设您使用的是Office 2010或更高版本）。

祝你好运。