Excel 2010:从原始位置移动单元格(偏移它)

程序: 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 | 

谢谢你,过个愉快的周末。

[编辑]请注意,这些单元格都没有合并,每个单元格是个人,“最后”和“澳元”需要被移动。

这应该为你工作:

 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