VBA設置片活性表名稱

Question

一直收到上ActiveWorkbook.Sheets（1）= wsData錯誤。所發生的是用戶將選擇csv文件，找到匹配則採取csv文件匹配在第4欄& 6和地點細胞值在的ThisWorkbook塔11 & 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