Excel 2010：从原始位置向右和向上移动单元格(偏移它)

Question

程序：Excel 2010
经验基本

问题：
我有一个大的数据表，里面有一些"拆分单元格"（名字/姓氏和货币），这就是原始数据的来源（从网页复制和粘贴，数据拆分为2）。我需要用1行而不是2行的所有数据制作一个干净的表。我在下面有一些示例数据，然后进一步介绍了我希望它看起来是什么样子。

原始格式是一个HTML表，从数据库中提取（我无法访问该数据库，但我可以生成CSV，但这本身就是另一个问题，因为它是如何设置的。）

假设：(A1)中的数据；存在多于所列出的值&列，我将接受公式或VBA答案，最后：忽略空白行，插入它们是为了更清楚地显示表之间的差异。

原始数据：

| Date       | Transaction ID | Order Reference | Sender | Sender Email | Status | Payment Amount | Amount Paid |
|------------|----------------|-----------------|--------|--------------|--------|----------------|-------------|
| 17/04/2014 | transid        | order           | first  | email        | Paid   | 5              | 5           |
|            |                |                 | last   |              |        | AUD            | AUD         |
|            |                |                 |        |              |        |                |             |
| 13/04/2014 | transid        | order           | first  | email        | Paid   | 5              | 5           |
|            |                |                 | last   |              |        | AUD            | AUD         |
|            |                |                 |        |              |        |                |             |
| 13/04/2014 | transid        | order           | first  | email        | Paid   | 5              | 5           |
|            |                |                 | last   |              |        | AUD            | AUD         |
|            |                |                 |        |              |        |                |             |
| 12/04/2014 | transid        | order           | first  | email        | Paid   | 5              | 5           |
|            |                |                 | last   |              |        | AUD            | AUD         |  

所需数据：（请注意，第一个/最后一个现在与货币位于同一行）

| Date       | Transaction ID | Order Reference | Sender |      | Sender Email | Status | Payment Amount |     | Amount Paid |     |
|------------|----------------|-----------------|--------|------|--------------|--------|----------------|-----|-------------|-----|
| 17/04/2014 | transid        | order           | first  | last | email        | Paid   | 5              | AUD | 5           | AUD |
|            |                |                 |        |      |              |        |                |     |             |     |
| 13/04/2014 | transid        | order           | first  | last | email        | Paid   | 5              | AUD | 5           | AUD |
|            |                |                 |        |      |              |        |                |     |             |     |
| 13/04/2014 | transid        | order           | first  | last | email        | Paid   | 5              | AUD | 5           | AUD |
|            |                |                 |        |      |              |        |                |     |             |     |
| 12/04/2014 | transid        | order           | first  | last | email        | Paid   | 5              | AUD | 5           | AUD |  

谢谢你，祝你周末愉快。

[编辑]注意，这些单元格都没有合并，每个单元格都是一个单独的单元格，"最后一个"&"澳元"需要向右移动&向上的

Answer 1

这应该适用于您：

Public Sub ModData()
    Dim colDate As Long
    Dim colTrans As Long
    Dim colOrder As Long
    Dim colSender As Long
    Dim colSenderEmail As Long
    Dim colStatus As Long
    Dim colPmtAmt As Long
    Dim colPaid As Long
    Dim r As Long
    Dim ws As Worksheet
    colDate = 1
    colTrans = 2
    colOrder = 3
    colSender = 4
    ' col 5 reserved for inserted col
    colSenderEmail = 6
    colStatus = 7
    colPmtAmt = 8
    ' col 9 reserved for inserted col
    colPaid = 10
    Set ws = ActiveSheet
    Application.ScreenUpdating = False
    ' Add extra columns needed.
    ws.Columns(colSender + 1).Insert Shift:=xlToRight
    ws.Columns(colPmtAmt + 1).Insert Shift:=xlToRight
    ' Move data to same row.
    For r = 2 To 12 Step 2
        ws.Cells(r, colSender + 1).Value = ws.Cells(r + 1, colSender).Value
        ws.Cells(r, colPmtAmt + 1).Value = ws.Cells(r + 1, colPmtAmt).Value
        ws.Cells(r, colPaid + 1).Value = ws.Cells(r + 1, colPaid).Value
    Next r
    ' Delete unnecessary rows.
    r = 3
    While ws.Cells(r - 1, 1).Value <> ""
        ws.Cells(r, 1).EntireRow.Delete
        r = r + 1
    Wend
    Application.ScreenUpdating = True
End Sub