[已解决]提取工作表某列最后一个数据

a563299530

Sub shtname()
    Dim i As Integer, sht As Worksheet
    i = 1
    For Each sht In Worksheets
        Sheet1.Hyperlinks.Add Cells(i, 1), "", sht.Name & "!A1", , sht.Name
        '在Cells(i,1)单元格添加超链接，超链接至sht工作表的A1单元格，超链接名为工作表名
        i = i + 1
    Next
End Sub
这段代码是提取所有工作表的名字并创建链接存放在A列。希望在这段代码的基础上，提取每个工作表某一列（希望编的程序能弹出选择哪一列，请考虑这列可能出现空格）最后一个数据并存放在B列。B列的数据和A列的工作表名一一对应。请各位高搜帮忙。
说明：以前老会计做的账目一个工作簿里面N个工作表，每个工作表一个客户，而每个工作表的某一列的最后一个数是应收款。我现在在做一个目录，方便查找，并能直接反映看每个客户的应收款项。工作表里一改动 目录里直接反映出来。

最佳答案

月排行榜 / 总排行榜

hrpotter

2012-6-20 12:01

请测试

1. Sub shtname()
   
2.     Dim i As Integer, j As Integer, sht As Worksheet
   
3.     Dim x As Range
   
4.     On Error Resume Next
   
5.     Set x = Application.InputBox("请选择要提取的列:", , , , , , , 8)
   
6.     If Not x Is Nothing Then
   
7.         i = 1
   
8.         j = x.Column
   
9.         For Each sht In Worksheets
   
10.             Sheet1.Hyperlinks.Add Cells(i, 1), "", "'" & sht.Name & "'!A1", , sht.Name
    
11.             Cells(i, 2) = sht.Cells(65536, j).End(xlUp).Value
    
12.             i = i + 1
    
13.         Next
    
14.     End If
    
15. End Sub

复制代码

跳转到最佳答案楼层

hrpotter

请测试

1. Sub shtname()
   
2.     Dim i As Integer, j As Integer, sht As Worksheet
   
3.     Dim x As Range
   
4.     On Error Resume Next
   
5.     Set x = Application.InputBox("请选择要提取的列:", , , , , , , 8)
   
6.     If Not x Is Nothing Then
   
7.         i = 1
   
8.         j = x.Column
   
9.         For Each sht In Worksheets
   
10.             Sheet1.Hyperlinks.Add Cells(i, 1), "", "'" & sht.Name & "'!A1", , sht.Name
    
11.             Cells(i, 2) = sht.Cells(65536, j).End(xlUp).Value
    
12.             i = i + 1
    
13.         Next
    
14.     End If
    
15. End Sub

复制代码

a563299530

hrpotter 发表于 2012-6-20 12:01
请测试

测试后 结果

hrpotter

不是输的，是选的

hrpotter

选你要提取的一列的任意单元格，输的话，要输完整的单元格地址

scsys1

1. 
   
2. Sub shtname()
   
3. Dim i As Integer, b As Integer, c As String
   
4.     Sheet1.Range("A2:B65536").ClearContents
   
5.     For i = 2 To Worksheets.Count
   
6.     Sheet1.Hyperlinks.Add Anchor:=Cells(i, 1), Address:="", SubAddress:=Sheets(i).Name & "!A1", TextToDisplay:=Sheets(i).Name
   
7.     c = InputBox("请输入" & Sheets(i).Name & "提取数据的列号：")
   
8.     b = Sheets(i).Range(c & "65536").End(xlUp).Row
   
9.     Sheet1.Cells(i, 2) = Sheets(i).Range(c & b)
   
10.     Next
    
11. End Sub
    

复制代码

yiguo

留个记号，好好学

zhaohu800

不放在B列，放在任意列怎么操作