Board logo

標題: 使用VAB按鈕完成資料 [打印本頁]
作者: koala2099    時間: 2013-10-29 00:51     標題: 使用VAB按鈕完成資料

VAB我在還學習中，所以不是很懂
但急迫在工作中(每天)使用頻繁只好上來求救，請求會的大大幫我

想使用VAB按鈕完成資料
作者: luhpro    時間: 2013-10-30 22:58

回復 1# koala2099
[attach]16515[/attach]
  1. Private Sub cbLdData_Click()
  2.   Dim iI%
  3.   Dim sSh$(0 To 1)
  4.   Dim lRow&, lRows&
  5.   Dim vFs, vF
  6.   
  7.   sSh(0) = "s"
  8.   sSh(1) = "e"
  9.   For iI = 0 To 1
  10.     With Sheets(sSh(iI))
  11.       .Activate
  12.       .Cells.ClearContents

  14.       Set vFs = CreateObject("Scripting.FileSystemObject")
  15.       Set vF = vFs.OpenTextFile(ThisWorkbook.Path & "\" & sSh(iI) & ".csv", 1, -2) ' 使用系統預設格式開啟唯讀文字檔案
  16.       lRow = 1
  17.       Do While Not vF.AtEndOfStream
  18.         With .Cells(lRow, 1)
  19.           .Value = vF.readline
  20.           .TextToColumns Comma:=True
  21.         End With
  22.         lRow = lRow + 1
  23.       Loop
  24.       vF.Close
  25.       .Range(.[A2], .[B2]).Insert shift:=xlShiftDown
  26.       lRow = 2
  27.       lRows = 2
  28.       Do While .Cells(lRows, 3) <> ""
  29.         If .Cells(lRows, 1) <> "" Then
  30.           .Rows(lRows).Cut
  31.           .Cells(lRow, 1).Insert
  32.           lRow = lRow + 1
  33.         End If
  34.         lRows = lRows + 1
  35.       Loop
  36. On Error GoTo LdDataErr
  37.       .[A1].SortSpecial key1:=.[A1], Header:=xlYes
  38.       lRows = 2
  39.       Do While .Cells(lRows, 1) <> ""
  40.         lRows = lRows + 1
  41.       Loop
  42.       .Rows(lRows & ":" & Rows.Count).Delete
  43.     End With
  44.   Next iI
  45. On Error GoTo 0
  46. Exit Sub
  47.   
  48. LdDataErr:
  49.   Select Case Err.Number
  50.     Case 1004
  51.       Resume Next
  52.     Case Else
  53.       MsgBox "發生錯誤, 錯誤代碼 : " & Err.Number & "  ,錯誤原因 : " & Err.Description
  54.       Exit Sub
  55.   End Select
  56. End Sub
複製代碼
作者: koala2099    時間: 2013-10-30 23:47

回復 2# luhpro


    :victory: 哇~~~好感動唷!以後工作可以加快許多了，非常謝謝您:loveliness:

可否在請教若檔案S及E是.xls，單純只要把S.xls工作表S、E.xls工作表E內的資料
分別複製到ALL.xls工作表S及E又該如何處理
(有時會有3~5個.xls的工作表)要複製到ALL原有工作表裡
因為ALL.xls裡我設有一個SUMIF統計全部數據表格
有在網路上找到都是新增新的工作表
不是把資料覆製到我原有工作表裡
所以我用SUMIF的連結全用不上又要重連
可否再請您幫幫我:$
作者: luhpro    時間: 2013-10-31 19:41

本帖最後由 luhpro 於 2013-10-31 19:48 編輯

回復 3# koala2099
  1. Sub nn()
  2.   Dim iI%
  3.   Dim sSh$(0 To 1)

  5.   sSh(0) = "S"
  6.   sSh(1) = "E"
  7.   For iI = 0 To 1
  8.     With Workbooks.Open(ThisWorkbook.Path & "\" & sSh(iI) & ".xls")
  9.       .Sheets(sSh(iI)).Cells.Copy Me.Parent.Sheets(sSh(iI)).[A1]
  10.       .Close SaveChanges:=False
  11.     End With
  12.   Next iI
  13. End Sub
複製代碼
註 : 1. 程式要與 E.xls(內有 Sheets("E")) 及 S.xls(內有 Sheets("S")) <- 此即要 Copy 的資料Sheet 兩個檔案放在同個目錄下.
      2. 在上述程式所在的檔案中,S 與 E 兩個 Sheet 必須存在, 否則會發生錯誤.
      3. 請留意 -  在上述程式所在的檔案中的 S 與 E 兩個 Sheet 的所有資料會全部被覆蓋掉.
      4. 如果每次都要複製到同一個 Sheet 內, 只要改第 9 行:
      .Sheets(sSh(iI)).Cells.Copy Me.Parent.Sheets("目的Sheet的名稱")).[A1]
作者: koala2099    時間: 2013-10-31 21:07

回復 4# luhpro


謝謝~問題是解決了!
只是有些不便，因為下載的資料Sheets名不同
還需先一一開啟檔案將 E.xls及S.xls(內Sheets重新命名為("E")) 、 S.xls(內 Sheets重新命名為("S")) ....
有時要匯E.xls、S.xls、A.xls、B.xls、C.xls....  ;P
本想從XML資料匯入再按右鍵重新整理，只是不知道為什麼所匯入的資料是[文字]非[數據]導致SUMIF無法加總
:dizzy: 所以都用手動一個一個複製貼上值
非常謝謝您的幫忙~辛苦了3Q^^
作者: luhpro    時間: 2013-10-31 21:17

回復 5# koala2099
如果確定目的檔案都很單純只有一個 Sheet 那第 9 行可以改成 :

.Sheets(1).Cells.Copy Me.Parent.Sheets(sSh(iI)).[A1]

即可.
作者: koala2099    時間: 2013-10-31 23:14

回復 6# luhpro
順利解決了  非常謝謝您的幫忙，讓我這菜卡能更順利完成工作~謝謝^^
Sub A()
  Dim iI%
  Dim sSh$(0 To 2)

  sSh(0) = "S"
  sSh(1) = "T"
  sSh(2) = "E"

    For iI = 0 To 2
    With Workbooks.Open(ThisWorkbook.Path & "\" & sSh(iI) & ".xls")
        .Sheets(1).Cells.Copy ThisWorkbook.Sheets(sSh(iI)).[A1]
      .Close SaveChanges:=False
    End With
  Next iI
  
End Sub
另其中有檔案是.csv參雜在裡面咧??



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)