帖子: 58
主題: 21
精華: 0
積分: 97
點名: 0
作業系統: win8
軟體版本: office2010
閱讀權限: 20
性別: 女
註冊時間: 2011-2-28
最後登錄: 2024-10-3

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2013-10-29 00:51 | 只看該作者

使用VAB按鈕完成資料

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

想使用VAB按鈕完成資料

ALL.zip (23.1 KB)

樓主熱帖

luhpro

高中生 Rank: 3 Rank: 3

帖子: 835
主題: 6
精華: 0
積分: 915
點名: 1
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2025-7-5

2^#

發表於 2013-10-30 22:58 | 只看該作者

回復 1# koala2099

all-a.zip (25.81 KB)

Private Sub cbLdData_Click()
Dim iI%
Dim sSh$(0 To 1)
Dim lRow&, lRows&
Dim vFs, vF
sSh(0) = "s"
sSh(1) = "e"
For iI = 0 To 1
With Sheets(sSh(iI))
.Activate
.Cells.ClearContents
Set vFs = CreateObject("Scripting.FileSystemObject")
Set vF = vFs.OpenTextFile(ThisWorkbook.Path & "\" & sSh(iI) & ".csv", 1, -2) ' 使用系統預設格式開啟唯讀文字檔案
lRow = 1
Do While Not vF.AtEndOfStream
With .Cells(lRow, 1)
.Value = vF.readline
.TextToColumns Comma:=True
End With
lRow = lRow + 1
Loop
vF.Close
.Range(.[A2], .[B2]).Insert shift:=xlShiftDown
lRow = 2
lRows = 2
Do While .Cells(lRows, 3) <> ""
If .Cells(lRows, 1) <> "" Then
.Rows(lRows).Cut
.Cells(lRow, 1).Insert
lRow = lRow + 1
End If
lRows = lRows + 1
Loop
On Error GoTo LdDataErr
.[A1].SortSpecial key1:=.[A1], Header:=xlYes
lRows = 2
Do While .Cells(lRows, 1) <> ""
lRows = lRows + 1
Loop
.Rows(lRows & ":" & Rows.Count).Delete
End With
Next iI
On Error GoTo 0
Exit Sub
LdDataErr:
Select Case Err.Number
Case 1004
Resume Next
Case Else
MsgBox "發生錯誤, 錯誤代碼 : " & Err.Number & " ,錯誤原因 : " & Err.Description
Exit Sub
End Select
End Sub

複製代碼

TOP

koala2099

中學生 Rank: 2

帖子: 58
主題: 21
精華: 0
積分: 97
點名: 0
作業系統: win8
軟體版本: office2010
閱讀權限: 20
性別: 女
註冊時間: 2011-2-28
最後登錄: 2024-10-3

3^#

發表於 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的連結全用不上又要重連
可否再請您幫幫我:$

TOP

luhpro

高中生 Rank: 3 Rank: 3

帖子: 835
主題: 6
精華: 0
積分: 915
點名: 1
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2025-7-5

4^#

發表於 2013-10-31 19:41 | 只看該作者

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

回復 3# koala2099

Sub nn()
Dim iI%
Dim sSh$(0 To 1)
sSh(0) = "S"
sSh(1) = "E"
For iI = 0 To 1
With Workbooks.Open(ThisWorkbook.Path & "\" & sSh(iI) & ".xls")
.Sheets(sSh(iI)).Cells.Copy Me.Parent.Sheets(sSh(iI)).[A1]
.Close SaveChanges:=False
End With
Next iI
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]

TOP

koala2099

中學生 Rank: 2

帖子: 58
主題: 21
精華: 0
積分: 97
點名: 0
作業系統: win8
軟體版本: office2010
閱讀權限: 20
性別: 女
註冊時間: 2011-2-28
最後登錄: 2024-10-3

5^#

發表於 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^^

TOP

luhpro

高中生 Rank: 3 Rank: 3

帖子: 835
主題: 6
精華: 0
積分: 915
點名: 1
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2025-7-5

6^#

發表於 2013-10-31 21:17 | 只看該作者

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

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

即可.

TOP

koala2099

中學生 Rank: 2

帖子: 58
主題: 21
精華: 0
積分: 97
點名: 0
作業系統: win8
軟體版本: office2010
閱讀權限: 20
性別: 女
註冊時間: 2011-2-28
最後登錄: 2024-10-3

7^#

發表於 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參雜在裡面咧??

TOP