[已解决]如何实现不同报表内的批注问题·紧急求助高手啊·····

linlianboy

如何实现将B报表内的C1：G1内的内容以批注的方式(并且自动调整好)插入到A报表内的B1中。




A报表.rar (1.61 KB, 下载次数: 8)

2012-10-13 21:30 上传

点击文件名下载附件

B报表.rar (4.69 KB, 下载次数: 2)

2012-10-13 21:30 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2012-10-13 23:39

1. Sub 批注()
   
2.     Dim arr, str$
   
3.     On Error Resume Next
   
4.     Workbooks("B.xls").Activate
   
5.     Worksheets("sheet1").Select
   
6.     arr = Range("c1:g1")
   
7.     For i = 1 To UBound(arr, 2)
   
8.         str = str & arr(1, i) & Chr(10)
   
9.     Next
   
10.     Workbooks("A.xls").Activate
    
11.     Worksheets("sheet1").Select
    
12.     Range("b1").AddComment
    
13.     'Range("b1").Comment.Visible = False
    
14.     Range("b1").Comment.Text Text:=str
    
15. End Sub

复制代码

发现多了一行空行，改过来了。

跳转到最佳答案楼层

hwc2ycy

C1:G1的内容全部写到B1的批注中。
每行内容要换行对不？

linlianboy

hwc2ycy 发表于 2012-10-13 23:06
C1:G1的内容全部写到B1的批注中。
每行内容要换行对不？

对啊，老大麻烦你帮我想想吧，我真的想不出来了·

hwc2ycy

如果要实现各列的内容换行的话，估计得用VBA了。

hwc2ycy

linlianboy 发表于 2012-10-13 23:09
对啊，老大麻烦你帮我想想吧，我真的想不出来了·

你会V不，会的话我就讲几个要点就行了。
偶不想动手写啊。

linlianboy

hwc2ycy 发表于 2012-10-13 23:15
你会V不，会的话我就讲几个要点就行了。
偶不想动手写啊。

会一点点VBA，就是懂的不是很多，所以一直想不出来。高手帮帮我吧，实在是很急，我现在都还在加班啊。就是想这个要怎么用VBA弄出来

hwc2ycy

1. Sub 批量合并添加批注()
   
2.     Dim sSwbk$, sDwbk$
   
3.     Dim sSsht$, sDsht$
   
4.     Dim arr, irow&, arrRst
   
5.     'Dim dic As Object
   
6.     Dim i&, j&
   
7.     sSwbk = "B.xls"
   
8.     sDwbk = "A.xls"
   
9.     sSsht = "Sheet1"
   
10.     sDsht = "Sheet1"
    
11.     Application.ScreenUpdating = False
    
12.     With Workbooks(sSwbk).Worksheets(sSsht)
    
13.         irow = .[b1].End(xlDown).Row
    
14.         arr = .Range("c1:g" & irow).Value
    
15.     End With
    
16.     ReDim arrRst(1 To UBound(arr)) As String
    
17.     For i = 1 To UBound(arr)
    
18.         For j = 1 To UBound(arr, 2)
    
19.             If arr(i, j) <> "" Then arrRst(i) = arrRst(i) & arr(i, j) & Chr(10)
    
20.         Next
    
21.     Next
    
22.     With Workbooks(sDwbk).Worksheets(sDsht)
    
23.         irow = [b1].End(xlDown).Row
    
24.         For i = 1 To irow
    
25.             .Cells(i, 2).AddComment Text:=arrRst(i)
    
26.         Next
    
27.     End With
    
28. End Sub

复制代码

hwc2ycy

同时打开A和B两个工作表，直接插入模块，粘贴进去运行就可以了。
不过只是针对B1这一个单元格。

hwc2ycy

1. Sub 批注()
   
2.     Dim arr, str$
   
3.     On Error Resume Next
   
4.     Workbooks("B.xls").Activate
   
5.     Worksheets("sheet1").Select
   
6.     arr = Range("c1:g1")
   
7.     For i = 1 To UBound(arr, 2)
   
8.         str = str & arr(1, i) & Chr(10)
   
9.     Next
   
10.     Workbooks("A.xls").Activate
    
11.     Worksheets("sheet1").Select
    
12.     Range("b1").AddComment
    
13.     'Range("b1").Comment.Visible = False
    
14.     Range("b1").Comment.Text Text:=str
    
15. End Sub

复制代码

发现多了一行空行，改过来了。

linlianboy

hwc2ycy 发表于 2012-10-13 23:39
发现多了一行空行，改过来了。

老大， 为什么运行了B1的批注却是空白的