返回列表 上一主題 發帖

[發問] 指定資料表

[發問] 指定資料表

本帖最後由 v03586 於 2016-11-3 06:07 編輯

請想問大大 如下程式碼 如何修改尋找指定的資料表名稱

我有兩個檔案  A檔案是直行檔  B檔案是參考資料來源
B檔案的Excel 名稱不固定 . 但內容的資料表名稱固定 , 如下寫法 只會判斷 B檔案的第一個順位資料表 , 外加判斷第一個資料表 Title 欄位當中的關鍵字
假設資料表順序一調換就無法判斷...想請問大大如何修改即使資料表順序調換也不影響程式判斷呢??

如下程式碼運作是開啟A檔案 與B檔案 , 執行程式後 會將B檔案的資料匯入A檔案指定的工作表欄位
With Workbooks(i).Sheets(1)
If .Range("A" & title_row).Value Like "A*" And .Range("D" & title_row).Value Like "B*" And .Range("E" & title_row) Like "C*"
Set xS = Workbooks(i).Sheets(1)
  1. Dim UType%
  2. Sub 匯入()

  3. Dim xFile$, x As New Application, xB As Workbook, xS As Worksheet
  4. Dim RepSht As Worksheet, xR As Range, xLab As Range, xAddress$
  5. Set RepSht = Sheets("A")

  6. Application.ScreenUpdating = False
  7. RepSht.UsedRange.EntireRow.Delete
  8.     Dim currentPKG, currentDevice, whichFirst As String
  9.     Dim index As Integer
  10.     Dim hasReport As Boolean
  11.     title_row = 1
  12.     hasReport = False
  13.     For i = 1 To Workbooks.Count
  14.         With Workbooks(i).Sheets(1)
  15.             If .Range("A" & title_row).Value Like "A*" And .Range("D" & title_row).Value Like "B*" And .Range("E" & title_row) Like "C*" Then
  16.                 Set xS = Workbooks(i).Sheets(1)
  17.                 hasReport = True
  18.                 i = Workbooks.Count + 1
  19.             End If
  20.         End With
  21.     Next i
  22.     If hasReport = False Then MsgBox "找不到檔案! ": Exit Sub
  23.     R = xS.Cells(Rows.Count, 1).End(xlUp).Row + 5
  24. With RepSht
  25.      .Range("A1:A" & R) = xS.Range("D1:D" & R).Value
  26.      .Range("B1:B" & R) = xS.Range("A1:A" & R).Value
  27.      .Range("C1:C" & R) = xS.Range("AH1:AH" & R).Value
  28.      .Range("D1:D" & R) = xS.Range("C1:C" & R).Value
  29.      .Range("E1:E" & R) = xS.Range("AB1:AB" & R).Value
  30.      .Range("F1:F" & R) = xS.Range("E1:E" & R).Value  
  31.      .Range("G1:G" & R) = xS.Range("F1:F" & R).Value
  32.      .Range("H1:H" & R) = xS.Range("G1:G" & R).Value  
  33.      .Range("I1:I" & R) = xS.Range("J1:J" & R).Value
  34.      .Range("J1:Z" & R) = xS.Range("K1:AA" & R).Value
  35.      .Range("AA1:AA" & R) = xS.Range("AD1:AD" & R).Value

  36. End With
  37. End Sub
複製代碼

回復 2# 葉國洲


    With Workbooks(i).Sheets(1) → With Workbooks(i)."工作表1"

這樣嗎???

TOP

回復 4# starry1314


    出現陣列引索超出範圍  錯誤

TOP

回復 6# c_c_lai

要讀取檔案資料表名稱  "H LOT"
開啟兩個Excel 檔  點選產生報表

    Report.rar (1013.15 KB)

TOP

回復 8# c_c_lai

我更改這樣 還是出現錯誤耶 , 陣列引索超出範圍
↓
With Workbooks(i).Sheets("H LOT")
  1. Dim xFile$, x As New Application, xB As Workbook, xS As Worksheet
  2. Dim RepSht As Worksheet, xR As Range, xLab As Range, xAddress$
  3. Set RepSht = Sheets("FMC")

  4. Sheets("FMC").Activate
  5. Application.ScreenUpdating = False

  6. RepSht.UsedRange.EntireRow.Delete
  7.     Dim currentPKG, currentDevice, whichFirst As String
  8.     Dim index As Integer
  9.     Dim hasReport As Boolean
  10.     title_row = 1
  11.     hasReport = False
  12.     For i = 1 To Workbooks.Count
  13.         With Workbooks(i).Sheets("H LOT")
  14.             If .Range("A" & title_row).Value Like "MONBR*" And .Range("D" & title_row).Value Like "DEVICE*" And .Range("E" & title_row) Like "PKG*" Then
  15.                 Set xS = Workbooks(i).Sheets("H LOT")
  16.                 hasReport = True
  17.                 i = Workbooks.Count + 1
  18.             End If
  19.         End With
  20.     Next i
  21.     If hasReport = False Then MsgBox "§ä¤£¨ì³øªíÀÉ¡I¡@": Exit Sub
  22.     R = xS.Cells(Rows.Count, 1).End(xlUp).Row + 5
複製代碼

TOP

        靜思自在 : 有多少力量就做多少事,不要心存等待,等待才會落空。
返回列表 上一主題