PDF转Excel（PS：学习使用VBA处理Excel）

昨天接到一个任务要将pdf中的表格转成excel，打开一看pdf有一百多页，看来手打是不可能了，只能想办法处理。

 

由于我拿到的PDF是这样的，第一步先把PDF转成word形式，我这里使用的是Adobe Acrobat，也可以使用wps等软件，转换完后效果如下：

发现还有个小问题，就是每页都有个大水印，这个水印由于是从pdf中转换来的，不是word里添加的，所以在word中关闭水印并不能处理这个问题。

双击水印发现其实是艺术字，学习网上方法采用VBA编写宏批量删除艺术字，代码如下：

Sub 删除艺术字()
    Dim sh As Shape
    For Each sh In ActiveDocument.Shapes
        If sh.Type = msoTextEffect Then
        sh.Delete
    End If
    Next
End Sub

 具体使用方法是点击视图-宏，然后在弹出的窗口中点创建，点完就会弹出VBA的编辑器，将代码粘进去即可，使用宏的时候在刚才点创建的窗口点执行即可。

艺术字就顺利删除了（ps：可能会有个别骨骼惊奇的艺术字没被删掉，多执行几遍还没被删掉的智只能手动删除）

下一步是将word中的表格转换成Excel，我们先将word保存成mht格式，点击文件-另存为，在弹出的窗口保存类型选择单一文件网页。

 之后在保存的位置就有这个文件了，下一步打开Excel，点击文件-打开，打开刚才我们保存的mht文件，将表格选中复制，粘贴到新的Excel文件中，效果如下：

 发现效果非常不好啊，一个格子里面由很多小格，格子里的一段话还分布在不同小格里，直接合并单元格会只保留最左上单元格的内容，同一个格子里的一段话势必会缺失很多，如果人工操作不知道要搞到猴年马月。

因此我把目光转向了宏，之前从没用过宏，经过网上学习，写出了第一个宏，可以将选中区域合并单元格的同时内容全部保留拼接起来

Sub 合并()

	Application.DisplayAlerts = False  '关闭提醒
    SelectionSum = ""
    For Each cell In Selection  '遍历选取区域的单元格
        SelectionSum = SelectionSum & cell.Value  '将单元格内容拼接起来
    Next cell
    Selection(1, 1).Value = SelectionSum  '将拼接后内容赋值给单元格
    Selection.Merge '合并
    Application.DisplayAlerts = True  '开启提醒
End Sub

 在Excel中使用宏比Word复杂些，第一次使用首先要点击文件-选项-自定义功能区，然后在右边勾选开发工具

之后关掉窗口，点击开发工具-录制宏，在弹出的窗口随便起名，然后点击停止录制，再点击旁边的宏，弹出的窗口就能看见刚才录制的宏，点击编辑即可进入VBA代码编辑器，将上述代码粘进去即可，再点击宏，选中你的宏后点击执行就可以。

但随后我发现用这个宏手动合并还是太低效了，观察发现每个要合并的格子周围都有黑色框线，于是想到通过识别框线来实现全局的自动化合并，经过半小时的网上学习，写出如下代码：

Sub 全局合并()
'
' 全局合并 宏
'

'
    Application.DisplayAlerts = False
    Dim k%, rng As Range, x%, first%, last%, col%
    For col = 4 To ActiveSheet.UsedRange.Columns.Count Step 1
        For k = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
            x = 0
            If Cells(k, col).Borders(xlEdgeLeft).LineStyle = 1 And Cells(k, col).Borders(xlEdgeRight).LineStyle = 1 Then
                If Cells(k, col).Borders(xlEdgeTop).LineStyle = 1 And Cells(k, col).Borders(xlEdgeBottom).LineStyle = xlNone Then
                    first = k
                    x = x + 1
                    SelectionSum = ""
                    For Each cell In Cells(k, col).Resize(last - first + 1, 1)
                        SelectionSum = SelectionSum & cell.Value
                    Next cell
                    Cells(k, col).Value = SelectionSum
                    Cells(k, col).Resize(last - first + 1, 1).Merge
                End If
                If Cells(k, col).Borders(xlEdgeTop).LineStyle = xlNone And Cells(k, col).Borders(xlEdgeBottom).LineStyle = xlNone Then
                    x = x + 1
                End If
                If Cells(k, col).Borders(xlEdgeTop).LineStyle = xlNone And Cells(k, col).Borders(xlEdgeBottom).LineStyle = 1 Then
                    x = x + 1
                    last = k
                End If
            End If
        Next k
    Next col
    Application.DisplayAlerts = True
End Sub

代码好长我懒得写注释了，说下大致思路，我这个表格所有要合并的项都是n行1列，所以双层循环，外层遍历每一列，内层遍历每一行。细节是行遍历从下往上方便些，因为每次合并操作会导致操作单元格下方内容变化，自上而下会影响遍历。分支条件为判定单元格有左右下框线且没上框线时记录为底端位置（last），只有左右框线时不操作，有左右上框线且没有下框线时记录为顶端位置（first），并且在底端位置和顶端位置之间进行内容拼接和合并操作。

 

最终结果效果成功实现，就截一部分吧，打码太累了

第一次尝试使用宏，体验很好，下次还来