搜索特定的列标题名称、复制列并粘贴以附加到另一个 wookbooksheet答案

【问题标题】：Search for specific column header names, copy columns and paste to append to another wookbooksheet搜索特定的列标题名称、复制列并粘贴以附加到另一个 wookbooksheet
【发布时间】：2013-03-21 03:16:15
【问题描述】：

我的工作簿有一张、两张或三张。每个工作表至少可以包含以下列标题名称之一：“Tel”或“Number”。

如何使用这些列标题名称复制整个列（仅限数据）并将它们（作为附加在具有相同列标题名称的一列中）粘贴到 VBA 代码（工作表模块）所在的另一个工作簿工作表中。谢谢。

【问题讨论】：

到目前为止您所尝试的会有所帮助。

标签： excel excel-2010 vba

【解决方案1】：

Option Compare Text

Sub search_and_append()

    Dim i As Long
    Dim width As Long
    Dim ws As Worksheet
    Dim telList As Object
    Dim count As Long
    Dim numList As Object
    Set telList = CreateObject("Scripting.Dictionary")
    Set numList = CreateObject("Scripting.Dictionary")


    ' search for all tel/number list on other sheets
    ' Assuming header means Row 1
    For Each ws In Worksheets
        If ws.Name <> Me.Name Then
            With ws
                .Activate
                width = .Cells(1, .Columns.count).End(xlToLeft).Column
                For i = 1 To width
                    If Trim(.Cells(1, i).Value) = "Tel" Then
                        Height = .Cells(.Rows.count, i).End(xlUp).Row
                        If Height > 1 Then
                            For j = 2 To Height
                                If Not telList.exists(.Cells(j, i).Value) Then
                                    telList.Add .Cells(j, i).Value, ""
                                End If
                            Next j
                        End If
                    End If
                    If Trim(.Cells(1, i).Value) = "Number" Then
                        Height = .Cells(.Rows.count, i).End(xlUp).Row
                        If Height > 1 Then
                            For j = 2 To Height
                                If Not numList.exists(.Cells(j, i).Value) Then
                                    numList.Add .Cells(j, i).Value, ""
                                End If
                            Next j
                        End If
                    End If
                Next
            End With
        End If

    Next

    ' paste the tel/number list found back to this sheet
    With Me
        .Activate
        width = .Cells(1, .Columns.count).End(xlToLeft).Column
        For i = 1 To width
            If Trim(.Cells(1, i).Value) = "Tel" Then
                Height = .Cells(.Rows.count, i).End(xlUp).Row
                count = 0
                For Each tel In telList
                    count = count + 1
                    .Cells(Height + count, i).Value = tel
                Next
            End If
            If Trim(.Cells(1, i).Value) = "Number" Then
                Height = .Cells(.Rows.count, i).End(xlUp).Row
                count = 0
                For Each tel In telList
                    count = count + 1
                    .Cells(Height + count, i).Value = tel
                Next
            End If
        Next
    End With

End Sub

【讨论】：

对不起，@Larry 和 kimtch，但不起作用。错误出现在我身上。名字和我。我替换了这个 Name Me，在导入工作簿中用我的名字创建了一张工作表，更改了 ws 集等等。如果你修复这个错误，我将不胜感激。谢谢。
@user2127061 将代码放入工作表模块，例如目标工作表是工作表1，然后将代码放入工作表1的代码模块中。
嗨，@拉里。现在它可以工作了。问题是我放代码的地方。尽管没有捕获列标题名称“数字”。然后我用“TEL”替换“Number”。你能适应这个吗？
@user2127061 你能澄清这个问题吗？您的意思是要将所有数据放在“数字”或“电话”中并附加到同一列吗？如果此代码解决了您最初的问题，您可能希望接受它。
嗨，@Larry。确切地。我使用替换方法将所有“数字”列转换为“电话”并且效果很好。