[已解决]请老师帮忙做下，本人研究了一天实在是没办法

simonleung

以下题目是我们考试题。做不出来要扣工资。实在是为难我不是做软件的人，我研究了很久，交卷时间马上就到了，请高手们能出招：
附件是我们的通讯录和考题。

最佳答案

月排行榜 / 总排行榜

zjdh

2014-6-19 21:53

满足了大部分功能
VBA考试答卷.rar (23.23 KB, 下载次数: 38)

2014-6-20 07:48 上传

点击文件名下载附件

跳转到最佳答案楼层

kevinshe

这题目太坑了  那么多条件,   太费脑细胞
请高手解答

zjdh

难度倒是不大，只是
旧直线        新分机号        旧分机  邮箱
分别要对应哪个字段，你们那刁钻的领导没做规定？

simonleung

zjdh 发表于 2014-6-19 15:25
难度倒是不大，只是
旧直线        新分机号        旧分机  邮箱
分别要对应哪个字段，你们那刁钻的领导没做规定？

旧直线        新分机号        旧分机这些没有做规定。在OUTLOOK工作簿里面没有的项，就没有规定。

=====是啊。总监太刁钻了。。。。让我一个做网络硬件的人来编程，就是整死我了。  他反正不管你现在岗位是什么，整个系统的人都要考这个BT题目。。

grf1973

1. Sub tt()
   
2.     arr = [a1].CurrentRegion
   
3.     ReDim brr(3 To UBound(arr), 1 To 60)
   
4.     For i = 3 To UBound(arr)
   
5.         If Len(arr(i, 1)) = 0 Then arr(i, 1) = arr(i - 1, 1)   '考虑第一列合并单元格
   
6.         bm = arr(i, 1)   '部门
   
7.         bm = Split(bm, Chr(10))(0)    '去掉回车符
   
8.         bm = Split(bm, "（")(0)    '去掉括号
   
9.         brr(i, 6) = bm       '部门
   
10.         xm = arr(i, 2)   '姓名
    
11.         brr(i, 4) = Left(xm, 1)    '名
    
12.         brr(i, 2) = Mid(xm, 2)   '姓
    
13.         brr(i, 32) = arr(i, 4) '电话1——旧直线
    
14.         brr(i, 33) = arr(i, 6) '电话2——旧分机
    
15.         brr(i, 36) = arr(i, 5) '单位主要电话——新分机
    
16.         brr(i, 41) = arr(i, 7) '移动电话——手机
    
17.         brr(i, 52) = arr(i, 8) '电子邮件
    
18.     Next
    
19.     Sheets("Outlook格式").Rows("2:65536").ClearContents
    
20.     Sheets("Outlook格式").[a2].Resize(i - 3, 60) = brr
    
21. End Sub
    

复制代码

grf1973

请看附件。

zjdh

满足了大部分功能
VBA考试答卷.rar (23.23 KB, 下载次数: 38)

2014-6-20 07:48 上传

点击文件名下载附件

simonleung

grf1973 发表于 2014-6-19 16:52
请看附件。

非常感谢，我试试

simonleung

zjdh 发表于 2014-6-19 21:53
满足了大部分功能

同样非常感谢，我试试功能

simonleung

zjdh 发表于 2014-6-19 21:53
满足了大部分功能

大神：
      不是很明白，求解释函数意思：


    ARR = Sheets("信息系统通讯录").Range("A2").CurrentRegion.Offset(1, 0)
    ReDim BRR(1 To UBound(ARR), 1 To Range("CN:CN").Column)