Question

我一直在ActiveWorkbook.Sheets（1）= wsData上收到错误。用户将选择一个csv文件，找到匹配然后在第4列和第4列中进行csv文件匹配。 6，并将单元格值放入ThisWorkbook专栏11＆amp; 12（其他匹配将偏移到下两列）。

如何在不知情的情况下设置工作表名称？我认为这会像之前的主题中提到的那样起作用。

  Dim wb As Workbook
  Dim ws As Worksheet
  Dim cel1 As Range, cel2 As Range


  Dim mywb As String, wsData As String

  thiswb = ActiveWorkbook.Name


  NewFile = Application.GetOpenFilename("Excel CSV Files (*.csv*),*.csv*", ,            "Select Report")

  'Check if file selected
  If NewFile = "False" Then
    MsgBox "No file was selected. Please try again.", vbExclamation
    GoTo WalkOut
  End If

 'Open wb
  Workbooks.Open Filename:=NewFile, ReadOnly:=True
  Application.ScreenUpdating = False
  'Check for matching part and paste data to col k
  With NewFile
   importwb = ActiveWorkbook.Name
  Set wsData = ActiveWorkbook.Sheets(1)
  'Set wsData = ActiveWorkbook.Sheets(1)
  For Each cel1 In ThisWorkbook.Sheets("Limited Data").UsedRange.Columns("H").Cells
    Dim offs As Long: offs = 3 ' <-- Initial offset, will increase by 2 after each match
    For Each cel2 In Workbooks(importwb).Worksheets(wsData).UsedRange.Columns("Z").Cells
        If cel1.Value = cel2.Value Then
            cel1.Offset(, offs).Value = cel2.Offset(, -22).Value ' <- wb2(d) to wb1(K)
            cel1.Offset(, offs + 1).Value = cel2.Offset(, -20).Value ' <- wb2(f) to wb1(L)
            offs = offs + 2 ' <-- now shift the destination column by 2 for next match
        End If
       Next
       Next
     End With


     Workbooks(importwb).Close savechanges:=False
     WalkOut:
     End Sub

Answer 1

这大部分都是猜测。看一下这些变化并尝试理解它们。这样你就可以自己纠正代码以使其工作：

Sub Something()
    Dim wb As Workbook
    Dim ws As Worksheet

    Dim newFile As String
    newFile = Application.GetOpenFilename("Excel CSV Files (*.csv*),*.csv*", , "Select Sequenced APT Parts and Tools Report")

    'Check if file selected
    If newFile = "False" Then
      MsgBox "No file was selected. Please try again.", vbExclamation
      Exit Sub
    End If

    'Open wb
    Set wb = Workbooks.Open(Filename:=newFile, ReadOnly:=True)
    'Check for matching part and paste data to col k

    Set ws = wb.Sheets(1)
    For Each cel1 In ThisWorkbook.Sheets("Limited Warranty     Data").UsedRange.Columns("H").Cells
        Dim offs As Long: offs = 3 ' <-- Initial offset, will increase by 2 after each match
        For Each cel2 In ws.UsedRange.Columns("Z").Cells
            If cel1.Value = cel2.Value Then
                cel1.Offset(, offs).Value = cel2.Offset(, -22).Value ' <- wb2(d) to wb1(K)
                cel1.Offset(, offs + 1).Value = cel2.Offset(, -20).Value ' <- wb2(f) to wb1(L)
                offs = offs + 2 ' <-- now shift the destination column by 2 for next match
            End If
        Next
    Next
    wb.Close savechanges:=False
End Sub

VBA将工作表设置为活动工作表名称

1 个答案: