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

Question

我的工作表有不同数量的行。列从A到R，基本上包含名称和地址。在客户名称下包含Co-signers，可以从无到10。我需要将Co-signer (1)行移到客户端行的末尾。如果客户端包含多个共同签名者，则下一个共同签名者(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) Donald Duck的信息将被移动到行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)记录并将其移动到第二行。

Answer 1

这是我的解决方案：

    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

我避免使用copy/paste或cut，因为这两种方法都需要范围，而且如果没有num_to_col函数很难递增一列。

请注意，有最大列数，因此每个客户端不能有太多的cs。如果每个客户端低于900，则应该没问题(假设您使用的是Office 2010或更高版本)。

祝好运。