- 帖子
- 81
- 主題
- 27
- 精華
- 0
- 積分
- 151
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- office2007
- 閱讀權限
- 20
- 性別
- 女
- 來自
- Taiwan
- 註冊時間
- 2012-6-7
- 最後登錄
- 2020-11-27
|
修改程式
因檔案越來越大, 目的資料己到了115000筆, 而每個月的來源資料至少都有9000多筆, 用以下的程式來run, 每次都要跑2~3小時.
不知高手們是否可以教導修改程式,可以讓資料的輸入速度可以快一些 ?
Public put_column, row_clear, row_index, put_row, row_search As Long
Sub 抓資料()
put_column = Sheets("作業區").Range("b1").Value
Sheets("Summary").Activate
ans0 = MsgBox("確定是Load至【" & put_column & "】欄嗎？", vbYesNo, "請確認")
If ans0 <> 6 Then
Sheets("作業區").Activate
Range("b1").Select
ans2 = MsgBox("請重新輸入正確的欄位！")
End
End If
ans = MsgBox("要清空 【" & put_column & "】欄的資料嗎？" & Chr(13) & Chr(13) & "【是】→ 清空，再放入數據" & Chr(13) & Chr(13) & "【否】→ 不清空，數據繼續累加", vbYesNo, "請確認")
If ans = 6 Then
row_clear = 3
While Cells(row_clear, 1).Value <> ""
row_clear = row_clear + 1
Wend
Range(put_column & Format(3) & ":" & put_column & Format(row_clear)).ClearContents
load_data
Else
load_data
End If
End Sub
Sub load_data()
row_index = 2
'從data的第二列開始尋找,一直找至Total為止
While Left(Sheets("data").Cells(row_index, 9).Value, 5) <> "Total"
Prod = Sheets("data").Cells(row_index, 3).Value
If Prod = "Electro-Dip" Or Prod = "Electro" Then
'將四個欄位連結起來
data_four_column = Sheets("data").Cells(row_index, 2).Value & Sheets("data").Cells(row_index, 3).Value & Sheets("data").Cells(row_index, 4).Value & Sheets("data").Cells(row_index, 9).Value
'如果Summary的a3儲存格是空白
If Sheets("Summary").Cells(3, 1).Value = "" Then
'就直接將找到的第一筆資料放進第三列
Sheets("Summary").Cells(3, 1).Value = Sheets("data").Cells(row_index, 2).Value
Sheets("Summary").Cells(3, 2).Value = Sheets("data").Cells(row_index, 3).Value
Sheets("Summary").Cells(3, 3).Value = Sheets("data").Cells(row_index, 4).Value
Sheets("Summary").Cells(3, 4).Value = Sheets("data").Cells(row_index, 9).Value
Sheets("Summary").Range(put_column & Format(3)).Value = Sheets("data").Cells(row_index, 10).Value
'否則
Else
'從第三列開始找起
row_search = 3
got_it = False
'一直找到空白為止
While Sheets("Summary").Cells(row_search, 1).Value <> ""
'將Summary的四個欄位連結起來
four_column = Sheets("Summary").Cells(row_search, 1).Value & Sheets("Summary").Cells(row_search, 2).Value & Sheets("Summary").Cells(row_search, 3).Value & Sheets("Summary").Cells(row_search, 4).Value
'如果在data找到的資料跟在Summary找到的相同,就把數量相加
If data_four_column = four_column Then
got_it = True
Sheets("Summary").Range(put_column & Format(row_search)).Value = Sheets("Summary").Range(put_column & Format(row_search)).Value + Sheets("data").Cells(row_index, 10).Value
End If
row_search = row_search + 1
Wend
'如果沒有找到相同的
If got_it = False Then
'就在最後一列新增一筆
Sheets("Summary").Cells(row_search, 1).Value = Sheets("data").Cells(row_index, 2).Value
Sheets("Summary").Cells(row_search, 2).Value = Sheets("data").Cells(row_index, 3).Value
Sheets("Summary").Cells(row_search, 3).Value = Sheets("data").Cells(row_index, 4).Value
Sheets("Summary").Cells(row_search, 4).Value = Sheets("data").Cells(row_index, 9).Value
Sheets("Summary").Range(put_column & Format(row_search)).Value = Sheets("data").Cells(row_index, 10).Value
row_search = row_search + 1
End If
End If
End If
row_index = row_index + 1
Wend
ans = MsgBox("已完成!")
End Sub |
-
-
程式修改.zip
(435.06 KB)
|
發表於 2012-10-8 23:35
| 
