对macros和文本框的代码进行故障诊断
我有一个工作的macros，通过文件夹循环打开文件，并从名称“持有人”和“切割工具”列中获得重要的信息，并打印所有的信息到一个Excel文档，masterfile。
我已经创build了一个文本框w /searchbutton，我可以input一个文件名，它会去那个文件夹并打开文件。
我试图改变我的macros，把它放到searchbutton的代码中，从“HOLDER”和"CUTTING TOOL"列中获取重要信息并将其打印到excel文档masterfile中。 这里是正在工作的macros和我为searchbutton量身定制的macros。
目前我困在改变的macros的Set hc = HeaderCell(ws.Cells(ROW_HEADER, 1), "CUTTING TOOL")部分（3）给出的错误对象variables或块variables未设置任何想法？
更新我以某种方式通过Set hc = HeaderCell(ws.Cells(ROW_HEADER, 1), "CUTTING TOOL")错误在第（3）节和另一个popup，同样的错误，在相似的行sectin（4） 。 现在我得到了相同的错误， 对象variables或没有设置块variables ，在（5）行上
StartSht.Cells(i, 1) = objFile.Name
我不确定这是否与这行代码有关，它是利用ws和.Worksheets ，还是完全不同的事实。 任何build议将是美好的！
改变的macros观：
Option Explicit Sub Search() Const ROW_HEADER As Long = 10 Dim objFSO As Object Dim objFolder As Object Dim MyFolder As String Dim objFile As Object Dim WB As Workbook Dim dict As Object Dim i As Integer Dim StartSht As Worksheet, ws As Worksheet Dim hc As Range, hc1 As Range, hc2 As Range, hc3 As Range, d As Range Set StartSht = Workbooks("masterfile.xlsm").Sheets("Sheet1") Set hc1 = HeaderCell(StartSht.Range("B1"), "HOLDER") Set hc2 = HeaderCell(StartSht.Range("C1"), "CUTTING TOOL") 'create an instance of the FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject") 'get the folder object i = 2 '(2) 'Open folder and file name, do not update links 'Set WB = Workbooks.Open(fileName:=MyFolder & objFile.Name, UpdateLinks:=0) 'Set ws = WB.ActiveSheet '(3) 'find CUTTING TOOL on the source sheet Set hc = HeaderCell(ws.Cells(ROW_HEADER, 1), "CUTTING TOOL") If Not hc Is Nothing Then Set dict = GetValues(hc.Offset(1, 0)) If dict.count > 0 Then Set d = StartSht.Cells(Rows.count, hc2.Column).End(xlUp).Offset(1, 0) 'add the values to the masterfile, column 3 d.Resize(dict.count, 1).Value = Application.Transpose(dict.items) End If Else 'header not found on source worksheet End If '(4) 'find HOLDER on the source sheet Set hc3 = HeaderCell(ws.Cells(ROW_HEADER, 1), "HOLDER") If Not hc3 Is Nothing Then Set dict = GetValues(hc3.Offset(1, 0)) If dict.count > 0 Then Set d = StartSht.Cells(Rows.count, hc1.Column).End(xlUp).Offset(1, 0) 'add the values to the master list, column 2 d.Resize(dict.count, 1).Value = Application.Transpose(dict.items) End If Else 'header not found on source worksheet End If '(5) With WB 'print TDS information For Each ws In .Worksheets 'print the file name to Column 1 StartSht.Cells(i, 1) = objFile.Name 'print TDS name from J1 cell to Column 4 With ws .Range("J1").Copy StartSht.Cells(i, 4) End With i = GetLastRowInSheet(StartSht) + 1 'move to next file Next ws '(6) 'close, do not save any changes to the opened files .Close SaveChanges:=False End With 'turn screen updating back on Application.ScreenUpdating = True ActiveWindow.ScrollRow = 1 '(7) End Sub '(8) 'get all unique column values starting at cell c Function GetValues(ch As Range) As Object Dim dict As Object, rng As Range, c As Range, v Set dict = CreateObject("scripting.dictionary") For Each c In ch.Parent.Range(ch, ch.Parent.Cells(Rows.count, ch.Column).End(xlUp)).Cells v = Trim(c.Value) If Len(v) > 0 And Not dict.exists(v) Then dict.Add c.Address, v End If Next c Set GetValues = dict End Function '(9) 'find a header on a row: returns Nothing if not found Function HeaderCell(rng As Range, sHeader As String) As Range Dim rv As Range, c As Range For Each c In rng.Parent.Range(rng, rng.Parent.Cells(rng.Row, Columns.count).End(xlToLeft)).Cells If Trim(c.Value) = sHeader Then Set rv = c Exit For End If Next c Set HeaderCell = rv End Function '(10) Function GetLastRowInColumn(theWorksheet As Worksheet, col As String) With theWorksheet GetLastRowInColumn = .Range(col & .Rows.count).End(xlUp).Row End With End Function '(11) Function GetLastRowInSheet(theWorksheet As Worksheet) Dim ret With theWorksheet If Application.WorksheetFunction.CountA(.Cells) <> 0 Then ret = .Cells.Find(What:="*", _ After:=.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row Else ret = 1 End If End With GetLastRowInSheet = ret End Function
完整的MACRO：
Option Explicit Sub LoopThroughDirectory() Const ROW_HEADER As Long = 10 Dim objFSO As Object Dim objFolder As Object Dim objFile As Object Dim MyFolder As String Dim StartSht As Worksheet, ws As Worksheet Dim WB As Workbook Dim i As Integer Dim LastRow As Integer, erow As Integer Dim Height As Integer Dim RowLast As Long Dim f As String Dim dict As Object Dim hc As Range, hc1 As Range, hc2 As Range, hc3 As Range, d As Range Set StartSht = Workbooks("masterfile.xlsm").Sheets("Sheet1") 'turn screen updating off - makes program faster Application.ScreenUpdating = False 'location of the folder in which the desired TDS files are MyFolder = "C:\Users\trembos\Documents\TDS\progress\" 'find the headers on the sheet Set hc1 = HeaderCell(StartSht.Range("B1"), "HOLDER") Set hc2 = HeaderCell(StartSht.Range("C1"), "CUTTING TOOL") '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 '(1) For Each objFile In objFolder.Files If LCase(Right(objFile.Name, 3)) = "xls" Or LCase(Left(Right(objFile.Name, 4), 3)) = "xls" Then '(2) 'Open folder and file name, do not update links Set WB = Workbooks.Open(fileName:=MyFolder & objFile.Name, UpdateLinks:=0) Set ws = WB.ActiveSheet '(3) 'find CUTTING TOOL on the source sheet Set hc = HeaderCell(ws.Cells(ROW_HEADER, 1), "CUTTING TOOL") If Not hc Is Nothing Then Set dict = GetValues(hc.Offset(1, 0)) If dict.count > 0 Then Set d = StartSht.Cells(Rows.count, hc2.Column).End(xlUp).Offset(1, 0) 'add the values to the masterfile, column 3 d.Resize(dict.count, 1).Value = Application.Transpose(dict.items) End If Else 'header not found on source worksheet End If '(4) 'find HOLDER on the source sheet Set hc3 = HeaderCell(ws.Cells(ROW_HEADER, 1), "HOLDER") If Not hc3 Is Nothing Then Set dict = GetValues(hc3.Offset(1, 0)) If dict.count > 0 Then Set d = StartSht.Cells(Rows.count, hc1.Column).End(xlUp).Offset(1, 0) 'add the values to the master list, column 2 d.Resize(dict.count, 1).Value = Application.Transpose(dict.items) End If Else 'header not found on source worksheet End If '(5) With WB 'print TDS information For Each ws In .Worksheets 'print the file name to Column 1 StartSht.Cells(i, 1) = objFile.Name 'print TDS name from J1 cell to Column 4 With ws .Range("J1").Copy StartSht.Cells(i, 4) End With i = GetLastRowInSheet(StartSht) + 1 'move to next file Next ws '(6) 'close, do not save any changes to the opened files .Close SaveChanges:=False End With End If 'move to next file Next objFile 'turn screen updating back on Application.ScreenUpdating = True ActiveWindow.ScrollRow = 1 '(7) End Sub '(8) 'get all unique column values starting at cell c Function GetValues(ch As Range) As Object Dim dict As Object, rng As Range, c As Range, v Set dict = CreateObject("scripting.dictionary") For Each c In ch.Parent.Range(ch, ch.Parent.Cells(Rows.count, ch.Column).End(xlUp)).Cells v = Trim(c.Value) If Len(v) > 0 And Not dict.exists(v) Then dict.Add c.Address, v End If Next c Set GetValues = dict End Function '(9) 'find a header on a row: returns Nothing if not found Function HeaderCell(rng As Range, sHeader As String) As Range Dim rv As Range, c As Range For Each c In rng.Parent.Range(rng, rng.Parent.Cells(rng.Row, Columns.count).End(xlToLeft)).Cells If Trim(c.Value) = sHeader Then Set rv = c Exit For End If Next c Set HeaderCell = rv End Function '(10) Function GetLastRowInColumn(theWorksheet As Worksheet, col As String) With theWorksheet GetLastRowInColumn = .Range(col & .Rows.count).End(xlUp).Row End With End Function '(11) Function GetLastRowInSheet(theWorksheet As Worksheet) Dim ret With theWorksheet If Application.WorksheetFunction.CountA(.Cells) <> 0 Then ret = .Cells.Find(What:="*", _ After:=.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row Else ret = 1 End If End With GetLastRowInSheet = ret End Function
你改变的macros有一个错误。 您评论过该行（请参阅“（3）”部分）：
'Set WB = Workbooks.Open(fileName:=MyFolder & objFile.Name, UpdateLinks:=0)
而在代码中稍后仍然使用这个variablesWB （参见“（5）”一节）
With WB
这就是为什么你得到'对象var没有设置'的错误信息。 你必须修复这个部分。 希望这可能有帮助。