Question

我想在一个工作簿中使用vlookup来引用另一个没有特定标识的工作簿的代码。

所以我几乎每个月都要使用vlookup来处理大约20种不同的报告，我想自动化它，但由于名称和其他类型的信息不同，我不能使用名称或索引

我检查了其他帖子，主要是我所看到的答案是引用名称或代替名称，索引的答案。因为每次我都无法引用它们时名称会有所不同，所以它不会成为一个自动化过程。我正在考虑寻找像＃34; ActiveWorkbook这样的参考资料。＆＃34; ＆＃34; ActiveWorkbook＆＃34; reference仅针对一个工作簿，但是有一个工作簿将输入数据，一个工作簿将输入源数据。

Answer 1

我相信您的问题是您在学习基础知识之前已经开始寻找有用的代码片段。这是一个非常普遍的问题，而且很多都比你更糟糕。有许多在线Excel VBA教程。尝试一下;找到一个符合你学习风格的人并完成它。我更喜欢书籍和在线教程。我参观了一个大型图书馆;回顾了他们的Excel VBA引物;借用了最承诺的;在家里完成了我的评论，买了一个我最喜欢的作为永久参考。

我需要您选择一个包含至少三个工作簿的文件夹，我将其称为工作簿A，B和C.工作簿A必须启用宏并且必须引用Microsoft Runtime Scripting库。至少一个工作簿应该有多个工作表。至少有一个工作表应在第1行中包含值。

将DemoWbkWsht复制到工作簿A中的新模块。在第49行中，替换＆＃34; SheetsMove.xlsm＆＃34;以工作簿C的名称。

打开工作簿B.转到“运行宏”并运行宏DemoWbkWsht。也就是说，在另一个工作簿中运行一个宏。宏DemoWbkWsht在文件夹中创建名为“DemoWbkWsht.txt”的文件。解决文件和宏检查输出和我用来创建输出的语句。我相信我已经展示了你需要知道的一切。尽可能回答问题但是，你越了解自己，你的发展就越快。

我特别希望你注意的一点：

ActiveWorkbook和ThisWorkbook
工作簿。打开更改ActiveWorkbook但不打开ThisWorkbook。
如何循环打开工作簿或创建数组工作簿引用并循环遍历它们。
如何遍历工作簿中的每个工作表。
每个工作簿的格式如何ActiveSheet。这是上次保存工作簿时激活的工作表。这就是我问这些工作簿是否有多个工作表的原因。如果工作簿只有一个工作表，则该工作表必须是活动工作表。
如何在任何打开的工作簿中查看任何工作表中的任何单元格。我已使用此功能列出每个工作表的第1行中的值。这些值是大多数工作表中的列标题。这是我的另一个问题：你能从标题中找出目标工作表吗？我怀疑你需要用户的帮助，我相信你的宏可以识别你需要访问的工作表。

祝你好运

Option Explicit
Sub DemoWbkWsht()

  ' Needs reference to Microsoft Scripting Runtime library. See Tools->References.

  Dim ColCrnt As Long
  Dim ColLast As Long
  Dim DiagFile As TextStream
  Dim Fso As New FileSystemObject
  Dim InxWbk As Long
  Dim InxWsht As Long
  Dim Path As String
  Dim WbkA As Workbook
  Dim WbkB As Workbook
  Dim WbkC As Workbook
  Dim WbkCrnt As Variant

  ' Updating the screen while updating a worksheet is the easiest way of
  ' ensuring your macro takes FOREVER to run. ALWAYS include this statement
  ' even if you do not think it is necessary.
  Application.ScreenUpdating = False

  ' Create reference to workbook holding this macro
  Set WbkA = ThisWorkbook

  ' Record path of workbook holding macro.
  Path = ThisWorkbook.Path & "\"

  ' Create the text file to which diagnostic file will be output within
  ' the folder holding the workbook holding this macro
  Set DiagFile = Fso.CreateTextFile(Path & "DemoWbkWsht.txt", True, False)

  ' List open workbooks.  Identify workbook B.
  DiagFile.WriteLine "***** Workbooks open when macro started"
  For InxWbk = 1 To Workbooks.Count
    DiagFile.WriteLine "  " & Workbooks(InxWbk).Name
    If Workbooks(InxWbk).Name <> WbkA.Name Then
      Set WbkB = Workbooks(InxWbk)
    End If
  Next

  ' List special workbooks.
  DiagFile.WriteLine "***** Special workbooks"
  DiagFile.WriteLine "  ActiveWorkbook: " & ActiveWorkbook.Name
  DiagFile.WriteLine "    ThisWorkbook: " & ThisWorkbook.Name
  DiagFile.WriteLine "      Workbook A: " & WbkA.Name
  DiagFile.WriteLine "      Workbook B: " & WbkB.Name

  Set WbkC = Workbooks.Open(Filename:=Path & "SheetsMove.xlsm")

  DiagFile.WriteLine "***** Special workbooks  after open of workbook C."
  DiagFile.WriteLine "  ActiveWorkbook: " & ActiveWorkbook.Name
  DiagFile.WriteLine "    ThisWorkbook: " & ThisWorkbook.Name
  DiagFile.WriteLine "      Workbook A: " & WbkA.Name
  DiagFile.WriteLine "      Workbook B: " & WbkB.Name
  DiagFile.WriteLine "      Workbook C: " & WbkC.Name

  ' List worksheets in workbooks A, B and C
  For Each WbkCrnt In VBA.Array(WbkA, WbkB, WbkC)
    With WbkCrnt
      DiagFile.WriteLine "***** Worksheets in workbook """ & .Name & """"
      With WbkCrnt
        For InxWsht = 1 To .Worksheets.Count
          DiagFile.WriteLine PadL(InxWsht, 4) & " " & .Worksheets(InxWsht).Name
        Next
        DiagFile.WriteLine "  ActiveWorksheet: " & .ActiveSheet.Name
      End With
    End With
  Next

  ' List worksheets in workbooks A, B and C
  For Each WbkCrnt In VBA.Array(WbkA, WbkB, WbkC)
    With WbkCrnt
      DiagFile.WriteLine "***** Worksheets in workbook """ & .Name & """"
      For InxWsht = 1 To .Worksheets.Count
        DiagFile.WriteLine PadL(InxWsht, 4) & " " & .Worksheets(InxWsht).Name
      Next InxWsht
      DiagFile.WriteLine "  ActiveSheet: " & .ActiveSheet.Name
    End With  ' WbkCrnt
  Next WbkCrnt

  ' List values from row 1 of worksheets in workbooks A, B and C
  For Each WbkCrnt In VBA.Array(WbkA, WbkB, WbkC)
    With WbkCrnt
      DiagFile.WriteLine "***** Values, if any, from row 1 of each worksheet in workbook """ & .Name & """"
      For InxWsht = 1 To .Worksheets.Count
        With .Worksheets(InxWsht)
          DiagFile.WriteLine PadL(InxWsht, 4) & " Worksheet: " & .Name
          ColLast = .Cells(1, .Columns.Count).End(xlToLeft).Column
          For ColCrnt = 1 To ColLast
            If .Cells(1, ColCrnt).Value <> "" Then
              DiagFile.WriteLine Space(5) & ColCode(ColCrnt) & "1=" & .Cells(1, ColCrnt).Value
            End If
          Next ColCrnt
        End With  ' .Worksheets(InxWsht)
      Next InxWsht
    End With  ' WbkCrnt
  Next WbkCrnt

  WbkC.Close SaveChanges:=False

  DiagFile.Close

  Application.ScreenUpdating = True

End Sub
Function ColCode(ByVal ColNum As Long) As String

  Dim PartNum As Long

  '  3Feb12  Adapted to handle three character codes.
  ' 28Oct16  Renamed ColCode to match ColNum.

  If ColNum = 0 Then
    Debug.Assert False
    ColCode = "0"
  Else
    ColCode = ""
    Do While ColNum > 0
      PartNum = (ColNum - 1) Mod 26
      ColCode = Chr(65 + PartNum) & ColCode
      ColNum = (ColNum - PartNum - 1) \ 26
    Loop
  End If

End Function
Public Function PadL(ByVal Str As String, ByVal PadLen As Long, _
                     Optional ByVal PadChr As String = " ") As String

  ' Pad Str with leading PadChr to give a total length of PadLen
  ' If the length of Str exceeds PadLen, Str will not be truncated

  '   Sep15 Coded
  ' 20Dec15 Added code so overlength strings are not truncated
  ' 10Jun16 Added PadChr so could pad with characters other than space

  If Len(Str) >= PadLen Then
    ' Do not truncate over length strings
    PadL = Str
  Else
    PadL = Right$(String(PadLen, PadChr) & Str, PadLen)
  End If

End Function

excel vba vlookup引用没有名称的单独工作簿

1 个答案: