返回列表 上一主題 發帖

[發問] 多筆EXCEL搜尋的用法[已解決 2011-05-11]

回復 10# mark15jill
3.那個原始碼 是套用大大您的   可是 剛有試驗過 不能 不過後來有新增我列的兩行 就OK了...就是sheet1 變成 TEXT名稱  (不知道哪出錯-0-)
可傳上完整程式碼看看??

TOP

這些是以大大的程式碼 加以延伸的..
  1. Sub 按鈕5_Click()
  2.     Dim Sh As Object

  3.     On Error Resume Next

  4.     Set Sh = ThisWorkbook.Sheets(1)

  5.    
  6.     With Workbooks.Add(xlWBATWorksheet)

  7.         Sh.UsedRange.Offset(1).Copy .Sheets(1).[A1]

  8.          .SaveAs ThisWorkbook.Path & "\" & Sh.TextBox1

  9.         .Close 0
  10.           Sheets("Sheet1").Select
  11.          Sheets("Sheet1").Name = Sh.TextBox1
  12.     End With

  13. End Sub
複製代碼
回復 11# GBKEE

TOP

回復 12# mark15jill
修改的程式,真的有達到你目地嗎?
Sub 按鈕5_Click()
    Dim Sh As Object
    On Error Resume Next      'On Error : 當程式執行時有錯誤時,   Resume Next : 繼續處裡下一個程式碼
                                               
    Set Sh = ThisWorkbook.Sheets(1)
    With Workbooks.Add(xlWBATWorksheet)
        Sh.UsedRange.Offset(1).Copy .Sheets(1).[A1]
         .SaveAs ThisWorkbook.Path & "\" & Sh.TextBox1  

          'SaveAs: 當目錄中有相同的檔名 系統會詢問是否覆蓋原檔案  如選擇 [否] 或[取消] 都會產生錯誤值
          'On Error 就是在處裡這錯誤
        .Close 0                                 '如選擇 [否] 或[取消]: 檔案關閉且不存檔
         Sheets("Sheet1").Select   '檔案已關閉:請問這裡的 Sheets("Sheet1")是哪一個??
         Sheets("Sheet1").Name = Sh.TextBox1
    End With
End Sub

TOP

本帖最後由 mark15jill 於 2011-5-11 10:39 編輯

End Sub[/code]回復 13# GBKEE
剛剛發現 我那兩行位置有打錯= =....(應該是後來我又亂改 沒注意到 抱歉ˊˋ)
原始碼差別 已經附加檔案

以下是兩者的代碼

台灣的部份
Sub 按鈕5_Click()
    Dim Sh As Object

    On Error Resume Next

    Set Sh = ThisWorkbook.Sheets(1)

   
    With Workbooks.Add(xlWBATWorksheet)
          Sheets("sheet1").Select      
          Sheets("sheet1").Name = Sh.TextBox1 ' 新增的那個檔案內的名稱為 TEXT的字眼
          Sh.UsedRange.Offset(1).Copy .Sheets(1).[A1]

         .SaveAs ThisWorkbook.Path & "\" & Sh.TextBox1

        .Close 0

    End With

End Sub


美國的部份
Sub 按鈕5_Click()
    Dim Sh As Object

    On Error Resume Next

    Set Sh = ThisWorkbook.Sheets(1)

   
    With Workbooks.Add(xlWBATWorksheet)

        Sh.UsedRange.Offset(1).Copy .Sheets(1).[A1]

         .SaveAs ThisWorkbook.Path & "\" & Sh.TextBox1

        .Close 0
        ' Sheets("Sheet1").Select
        ' Sheets("Sheet1").Name = Sh.TextBox1
    End With

End Sub


附加檔案內有兩個 TXT 和 EXCEL檔案  分別為 美國和 台灣
查詢比對.rar (10.14 KB)

TOP

回復 14# mark15jill
9樓程式碼中的 .Sheets(1).Name = Sh.TextBox1      '工作表名稱
        這紅點表示在所新增的活頁簿裡 不必再有   Sheets(1).Select

TOP

回復 15# GBKEE


    多謝指導><
習慣性都會多指定那個...

TOP

        靜思自在 : 盡多少本份,就得多少本事。
返回列表 上一主題