麻辣家族討論版版 » Excel程式區 » 註解轉表格試算的問題

返回列表下一主題上一主題發帖

[發問] 註解轉表格試算的問題

小學生 Rank: 1

帖子: 10
主題: 2
精華: 0
積分: 12
點名: 0
作業系統: Windows
軟體版本: 8.1
閱讀權限: 10
性別: 男
註冊時間: 2015-5-8
最後登錄: 2016-1-12

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2015-5-18 12:12 | 只看該作者

[發問] 註解轉表格試算的問題

原本POST 在"EXCEL 一般區"把問題移植過來，很抱歉:L

----------------------------------------------------------

各位前輩好

我有個問題請教：
我目前工作有使用EXCEL 做產品的記錄，因為每次使用的零件不一定，也為了欄位美觀
所以會在"成本欄"使用"註解"來登記使用的零件(成本欄是空的)

但是在計算使用成本，都是一個一個把註解內容複製到分頁，人工計算各成本，再加總總成本再填回"成本欄"

我有找到程式讓註解內容轉成儲存格，但是會轉成同一儲存格，還是無法EXCEL試算

想詢問前輩有沒有方法，能將上述紅字部分讓EXCEL 自動去執行的方式

謝謝~
----------------------------------------------------------
我將目前處理的狀態，表列如下，再煩請幫忙確認

這是要將註解拉出來的範例，實際上有許多欄位
範例1.jpg

目前找到並修改的程式如下
1. 先建立一新的工作表"試算"
2.將上圖註解，拉出到"試算"工作表
但是會排成一長條

但是希望是下述模式，因為有的是沒有註解的，
希望能照原本欄位方式顯示

-------------------------------------------------

拉出後的狀況
因為註解有一些不必要的文字，想重新整理，
例如
1. 有"ASUS:" 字樣
2. 有的"*"有空格，有的沒有
3. 有的有"，"，有的沒有
但是用錄製巨集，使用"取代"功能，再將程式碼COPY過來，卻不能用

其實主要是想依據為相同序號的Consumable Parts & Repair Parts 註解中所記錄的資料，
依據成本欄位的金額(目前用VLOOKUP)
試算完各自的總費用再回填至原本註解的欄位

因為公司沒有使用系統，又需花很多人力去做資料整理，想做有沒有快速的辦法
煩請前輩高手幫幫忙
感恩

下面附檔件，是EXCEL 含上述巨集檔，請前輩們幫忙看一下，謝謝~

2014年維修登記.zip (162.38 KB)

收藏

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2015-5-18 16:02 | 只看該作者

回復 1# OsakaKYC
試試看

Option Explicit
Sub Ex()
Dim D As Object, S As Variant, i As Integer
Dim xSum As Single, E As Range, Msg As String
Dim 料號 As String
Set D = CreateObject("scripting.dictionary") '字典物件
With Sheets("成本")
i = 2
Do While .Cells(i, "B") <> "" '料號欄
D(Trim(.Cells(i, "B"))) = .Cells(i, "C").Value '料號的成本
i = i + 1
Loop
End With
For Each E In Sheets("2014年維修明細").UsedRange.Columns("B:C").Cells
If E.NoteText <> "" Then
xSum = 0
S = Split(Trim(E.NoteText), vbLf)
For i = 1 To UBound(S)
If Len(S(i)) > 0 Then
料號 = Trim(Split(S(i), "*")(0))
If D.EXISTS(料號) = False Then '料號不存在
Msg = Msg & vbLf & Trim(Split(S(i), "*")(0))
End If
xSum = xSum + (D(料號) * Val(Split(S(i), "*")(1))) '成本累計
End If
Next
E = xSum
End If
Next
If Msg <> "" Then MsgBox Msg, , "料號不存在"
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

小學生 Rank: 1

帖子: 10
主題: 2
精華: 0
積分: 12
點名: 0
作業系統: Windows
軟體版本: 8.1
閱讀權限: 10
性別: 男
註冊時間: 2015-5-8
最後登錄: 2016-1-12

3^#

發表於 2015-5-18 16:39 | 只看該作者

回復 2# GBKEE

感謝大大，您真的太厲害了
我試了一下，功能超正常

只有一個小小的問題，就是如果某一欄的註解中，藏有一些說明文字(不管中文或是英文字)，就會出現"陣列索引超出範圍"
這部分有辦法解決嗎?

感恩

小學生 Rank: 1

帖子: 10
主題: 2
精華: 0
積分: 12
點名: 0
作業系統: Windows
軟體版本: 8.1
閱讀權限: 10
性別: 男
註冊時間: 2015-5-8
最後登錄: 2016-1-12

4^#

發表於 2015-5-18 17:23 | 只看該作者

回復 2# GBKEE

請問
1.如果"成本"不在同一個檔案中，在其他的資料夾中也可以嗎?
2.有時候會出現"料號不存在"，有時會出現"陣列索引超出範圍"，這狀況是不一樣嗎?

抱歉，勞費心了，
感恩

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

5^#

發表於 2015-5-19 05:43 | 只看該作者

回復 4# OsakaKYC
如果某一欄的註解中，藏有一些說明文字(不管中文或是英文字)，就會出現"陣列索引超出範圍"
如何藏法給看看.

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

小學生 Rank: 1

帖子: 10
主題: 2
精華: 0
積分: 12
點名: 0
作業系統: Windows
軟體版本: 8.1
閱讀權限: 10
性別: 男
註冊時間: 2015-5-8
最後登錄: 2016-1-12

6^#

發表於 2015-5-26 11:53 | 只看該作者

回復 5# GBKEE

版主大好，不好意思，國外出差一個禮拜才剛回來，沒有及時回覆很抱歉

下圖是跑巨集時會出現"陣列索引超出範圍"的狀況
跑到這欄位就會停止，但是刪除註解後功能就都正常
也能順利帶出"料號不存在"的訊息，確認是人為輸入錯誤導致

但現在比較麻煩的問題是"無法存檔"
當我選擇存檔時，會依序出現

這時我會改存".xlsm"，則會繼續出現以下錯誤

最後只有".xlsx"能存，但是就不包括巨集
有試過不同電腦，情形是一樣的
我們使用的是"Office 2010"
不知該如何處理，再麻煩了
謝謝~

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

7^#

發表於 2015-5-26 13:47 | 只看該作者

本帖最後由 GBKEE 於 2015-5-26 13:48 編輯

回復 6# OsakaKYC
無法存檔的錯誤,我只有2003版,尚請有2010版者測試看看.

出現"陣列索引超出範圍"的狀況,這錯誤可修改如下試試

For Each E In Sheets("2014年維修明細").UsedRange.Columns("B:C").Cells
If E.NoteText <> "" Then
xSum = 0
S = Split(Trim(E.NoteText), vbLf)
For i = 1 To UBound(S)
If Len(S(i)) > 0 Then
料號 = Trim(Split(S(i), "*")(0))
If D.EXISTS(料號) = False Then '料號不存在
Msg = Msg & vbLf & Trim(Split(S(i), "*")(0))
Else
xSum = xSum + (D(料號) * Val(Split(S(i), "*")(1))) '成本累計
End If
End If
Next
E = xSum
End If
Next

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

小學生 Rank: 1

帖子: 10
主題: 2
精華: 0
積分: 12
點名: 0
作業系統: Windows
軟體版本: 8.1
閱讀權限: 10
性別: 男
註冊時間: 2015-5-8
最後登錄: 2016-1-12

8^#

發表於 2015-5-26 15:53 | 只看該作者

回復 7# GBKEE

版大感謝，所有的問題都解了

您的新程式運作沒有問題

另外，無法存檔的問題確定為我另外分頁中"圖片物件"太多導致

只要刪除圖片就好了

再三感謝您:loveliness:

靜思自在 : 【做人的開始】每一天都是故人的開始，每一個時刻都是自己的警惕。

返回列表下一主題上一主題