VBA 把电信的电话费用表转换成部门电话费用明细表（图文）

今天同事要做一个这种工作。就是把电信发来的费用表，转换成按部门划分的电话费用表，100多部电话，假设一个个去核对，真还是须要些时间的。问题来了，有更好的方法么，我们来看一下。

电信公司给的费用明细是这个样子的，单个号码与费用合计并不在一起。

watermark/2/text/aHR0cDovL2Jsb2cuY3Nkbi5uZXQvdXBpMnU=/font/5a6L5L2T/fontsize/400/fill/I0JBQkFCMA==/dissolve/70/gravity/SouthEast" alt="" />

先通过Excel的筛选功能，去掉号码的空格行，这样把号码和费用放的近一点。因为中间的数据行数不是固定的，这样至少仅仅差一行，就好办多了。

因为错开一行。把费用行数据总体剪切上移一行就可以与号码在同一行。再把没实用的行列删除就可以。

这是转换后的结果。如A列和C列。

因为部门费用表中并没有区号显示。所以两者进行对接须要对号码进行处理一下。这不把A列截取右边8位就可以。有一个宽带号码特殊的情况，须要手动处理一下。

这个就是部门费用表，上面的数据须要相应号码更新费用到以下这个表里面。原来的两张费用表用着不方便先放到一个Sheet中，这样查找起来方便多了。

写一个VBA的程序，对整理的号码进行循环。然后在部门号码表里查找，找到的话就将右边的值进行替换。

这里面进行了一个出错的处理，否则假设不处理的话有找不到号码的时候就会报错而运行不下去。

Sub getDate()

    On Error Resume Next                                         '不报错继续运行

    For cln = 1 To 147
            PhoneNumber = Sheets("sheet1").Cells(cln, 2)
            money = Sheets("sheet1").Cells(cln, 3)

            Dim rng As Range
            Set rng = Worksheets("总公司").Range("E1:E187").Find(PhoneNumber, , , 1)

           ' MsgBox (rng.Address)

            rng.Offset(0, 1).Value = money                        '向右偏移一列即为费用值

            If Err.Number = 0 Then

                Sheets("sheet1").Cells(cln, 4) = "OK"             '成功标识

            End If

            If Err.Number <> 0 Then

                Sheets("sheet1").Cells(cln, 4) = "Error"          '错误标识，重点查看就可以
                Err.Number = 0
            End If
    Next

End Sub

程序都运行完了，再核对一下，对特殊的几个号码再处理一下就OK了。