Question

如何使用这些列标题名称“TOOL CUTTER”和“HOLDER”复制列（仅限数据）并粘贴它们（作为只有一列的附加，每个列具有相同的列标题名称）到另一个工作簿表中VBA代码（Sheet Module）是。感谢。

行"If Sht <> "masterfile.xls" Then是问题发生的地方。我得到了另一个在线资源的帮助，其中这一行If ws.name <> me.name Then显然我想在这里写一个不同的名字，但我无法弄清楚是什么。

不需要这种解决方法，这就是我现在所拥有的。

我打开多个文件，这就是为什么我主要使用ActiveSheet方法而不是Sheet1 Sheet2。我的代码所在的文件名为“masterfile.xls”

非常感谢任何帮助!!

以前的代码大纲帮助在此处找到：Search for specific column header names, copy columns and paste to append to another wookbooksheet

Sub LoopThroughDirectory()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim MyFolder As String
    Dim Sht As Worksheet
    Dim i As Integer
    Dim LastRow As Integer, erow As Integer

    'Speed up process by not updating the screen
    'Application.ScreenUpdating = False

    MyFolder = "C:\Users\trembos\Documents\TDS\progress\"

Set Sht = ActiveSheet

    'create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'get the folder object
    Set objFolder = objFSO.GetFolder(MyFolder)
    i = 1
    'loop through directory file and print names
    For Each objFile In objFolder.Files

        If LCase(Right(objFile.Name, 3)) <> "xls" And LCase(Left(Right(objFile.Name, 4), 3)) <> "xls" Then
        Else
            'print file name
            Sht.Cells(i + 1, 1) = objFile.Name
            i = i + 1
            Workbooks.Open fileName:=MyFolder & objFile.Name

        End If

        Dim k As Long
        Dim width As Long
        Dim ws As Worksheet
        Dim TOOLList As Object
        Dim count As Long
        Set TOOLList = CreateObject("Scripting.Dictionary")

        ' search for all tel/number list on other sheets
        ' Assuming header means Row 1
        For Each ws In Worksheets
            If Sht <> "masterfile.xls" Then
                With ActiveSheet
                    .Activate
                    width = .Cells(10, .Columns.count).End(xlToLeft).Column
                    For k = 1 To width
                        If Trim(.Cells(10, k).Value) = "CUTTING TOOL" Then
                            Height = .Cells(.Rows.count, k).End(xlUp).Row
                            If Height > 1 Then
                                For j = 2 To Height
                                    If Not TOOLList.exists(.Cells(j, k).Value) Then
                                        TOOLList.Add .Cells(j, k).Value, ""
                                    End If
                                Next j
                            End If
                        End If
                    Next
                End With
            End If

        Next

        ' paste the TOOL list found back to this sheet
        With masterfile.xls
            .Activate
            width = .Cells(10, .Columns.count).End(xlToLeft).Column
            For k = 1 To width
                If Trim(.Cells(10, k).Value) = "CUTTING TOOL" Then
                    Height = .Cells(.Rows.count, k).End(xlUp).Row
                    count = 0
                    For Each TOOL In TOOLList
                        count = count + 1
                        .Cells(Height + count, k).Value = TOOL
                    Next
                End If
            Next
        End With








        'Range("J1").Select
        'Selection.Copy
        'Windows("masterfile.xlsm").Activate
        'Range("D2").Select
        'ActiveSheet.Paste
        ActiveWorkbook.Close SaveChanges:=False

        Next objFile

'Application.ScreenUpdating = True

End Sub

Answer 1

sht是指此代码所在的工作簿中的活动工作表，因为Set Sht = ActiveSheet
sht是一个对象变量，永远不会等于字符串值"masterfile.xls"
sht.name会为您提供工作表的（字符串）名称，您可以将其与字符串值"masterfile.xls"进行比较，但这仍然不能告诉您之前的情况，因为：
- 您将WorkSheet（sht.name）的名称与WorkBook（masterfile.xls）的文件名混淆。
If LCase(Right(objFile.Name, 3)) <> "xls" And Case(Left(Right(objFile.Name, 4), 3)) <> "xls" Then Else是一个非常尴尬的构造。将其更改为：
- If LCase(Right(objFile.Name, 3)) = "xls" or Case(Left(Right(objFile.Name, 4), 3)) = "xls" Then并删除else子句。它会使它更具可读性
我认为If Sht <> "masterfile.xls" Then旨在跳过WorkBook masterfile.xls的处理，如果是这样的话：
- If Sht.Cells(i, 1) <> "masterfile.xls" Then应该可以解决问题，因为您在代码中先存储了文件名。（注意：使用后立即增加i，所以你必须在这里使用一个较小的值。）
Workbooks.Open fileName:=MyFolder & objFile.Name将打开新的工作簿，但是很容易对您正在查看的工作簿感到困惑。试试Set NewWb = Workbooks.Open fileName:=MyFolder & objFile.Name，现在你有一个坚实的手柄可以参考这个。
With ActiveSheet .Activate简直就是多余的。 ActiveSheet是活动表，无需激活它。
With masterfile.xls是完全无功能的陈述。期待某种集合对象可以使用With，masterfile.xls不是。它不是一个字符串（没有引号），它不是任何类型的变量（从未声明），它不是具有方法或属性（xls）的对象（masterfile）。这表示您没有在代码顶部设置Option Explicit。您应该始终这样做，因为它会使这成为编译时错误，而不是运行时错误。
如果以上有效，ActiveWorkbook.Close SaveChanges:=False会关闭您正在运行的工作簿，因为您已经激活了它。

试试这段代码，它可能不是100％，至少应该让你更接近你所追求的目标：

Option Explicit
Sub LoopThroughDirectory()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim MyFolder As String
    Dim StartSht As Worksheet
    Dim i As Integer
    Dim LastRow As Integer, erow As Integer

    MyFolder = "C:\Users\trembos\Documents\TDS\progress\"

    Set StartSht = ActiveSheet

    'create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'get the folder object
    Set objFolder = objFSO.GetFolder(MyFolder)
    i = 2
    'loop through directory file and print names
    For Each objFile In objFolder.Files
        If LCase(Right(objFile.Name, 3)) = "xls" Or LCase(Left(Right(objFile.Name, 4), 3)) = "xls" Then
            'print file name
            StartSht.Cells(i, 1) = objFile.Name
            Dim NewWb As Workbook
            Set NewWb = Workbooks.Open(FileName:=MyFolder & objFile.Name)
        End If

        Dim k As Long
        Dim width As Long
        Dim ws As Worksheet
        Dim TOOLList As Object
        Dim count As Long
        Set TOOLList = CreateObject("Scripting.Dictionary")

        ' search for all tel/number list on other sheets
        ' Assuming header means Row 1
        If objFile.Name <> "masterfile.xls" Then 'skip any processing on "Masterfile.xls"
            For Each ws In NewWb.Worksheets   'assuming we want to look through the new workbook
                With ws
                    width = .Cells(10, .Columns.count).End(xlToLeft).Column
                    For k = 1 To width
                        If Trim(.Cells(10, k).Value) = "CUTTING TOOL" Then
                            Height = .Cells(.Rows.count, k).End(xlUp).Row
                            If Height > 1 Then
                                For j = 2 To Height
                                    If Not TOOLList.exists(.Cells(j, k).Value) Then
                                        TOOLList.Add .Cells(j, k).Value, ""
                                    End If
                                Next j
                            End If
                        End If
                    Next
                End With
            Next
        End If

        ' paste the TOOL list found back to this sheet
        With StartSheet
            width = .Cells(10, .Columns.count).End(xlToLeft).Column
            For k = 1 To width
                If Trim(.Cells(10, k).Value) = "CUTTING TOOL" Then
                    Height = .Cells(.Rows.count, k).End(xlUp).Row
                    count = 0
                    For Each TOOL In TOOLList
                        count = count + 1
                        .Cells(Height + count, k).Value = TOOL
                    Next
                End If
            Next
        End With
        NewWb.Close SaveChanges:=False
        i = i + 1
    Next objFile

'Application.ScreenUpdating = True

End Sub

搜索特定列标题，复制列并粘贴到另一个工作簿

1 个答案: