sax868

帖子: 37
主題: 9
精華: 0
積分: 61
點名: 0
作業系統: Windows7
軟體版本: office 2010
閱讀權限: 20
性別: 女
註冊時間: 2011-4-26
最後登錄: 2014-7-28

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2012-4-7 01:50 | 只看該作者

[發問] 請問如何撰寫VBA，使特定數值成為所對應於其他工作表儲存格內容並加總 (已解決)

[版主管理留言]

Hsieh(2012-4-7 08:58): 請將檔案壓縮上傳

本帖最後由 sax868 於 2012-5-8 23:06 編輯

親愛的大大們晚安！

因為我試了整天的函數沒結果，能不能麻煩請大大救我...
請問如何撰寫VBA，使特定數值所對應於其他工作表儲存格內容並加總
我試著用巢狀
SUMIFS+MID+SEARCH+OR+VLOOKUP+LEN+LEFT..寫函數但是有障礙...結果出不來 (Sheet 4 有各種size做參考),所以即便我設立函數也無法跑出資料(大概是我自己不會...)
目前遇到的困難為:
1. Color共四種(ABCD): 單一color A (1330000_A) 可以直接用vlookup在Color表中找出對應的數量百分比, 但一旦數值為複數(例:Color A, B 或 Color B,C,D), 則無法計算。
2. Size排列組合共258種: 單一size 15 可以直接用vlookup在size表中找出對應的數量百分比, 但一旦數值為複數(例:Size 15, 17.5), 則無法計算。

請問要如何使:
1. "G:G_FF" (例: G2_F2: 133000_AA)
2. Model Number 1330000的Size總共要是(P2值)=1330000_15.5L的12.94%+1330000_17.5的39.59%+1330000_20的34.89%+1330000_22.5的11.77%+1330000_25的0.80%，所以等於100%
3. Model Number 1330000的Color總共要是(Q2值)=1330000_A的22.95%+1330000_B的51.83%+1330000_C的13.35%+1330000_D的11.86%，所以等於100%
因為資料是3萬多筆,且那些百分比會因為不同model有不同尺寸規格而產生不同數列排序的可能。我爬文整晚看來看去覺得只能寫VBA最適當了。麻煩請大大高手們救我!! 拜託!!

感激萬分!!

謝謝!!

弱女子留

樓主熱帖

sax868

中學生 Rank: 2

帖子: 37
主題: 9
精華: 0
積分: 61
點名: 0
作業系統: Windows7
軟體版本: office 2010
閱讀權限: 20
性別: 女
註冊時間: 2011-4-26
最後登錄: 2014-7-28

7^#

發表於 2012-4-8 23:50 | 只看該作者

這真的太神奇了!!讓我一下又從地獄回到了天堂~
超級版主真的太感激您了!您是我的救命恩人!! 真的非常謝謝您的幫忙!!
回復 6# Hsieh

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 155
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2025-6-27

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

6^#

發表於 2012-4-8 22:46 | 只看該作者

回復 5# sax868

Sub ex()
Dim A As Range
Set d = CreateObject("Scripting.Dictionary")
With Sheet2 'Size
For Each A In .Range(.[A2], .Cells(.Rows.Count, 1)).SpecialCells(xlCellTypeConstants)
d(A & A.Offset(, 2)) = A.Offset(, 3).Value
Next
With Sheet3 'Color
For Each A In .Range(.[A2], .Cells(.Rows.Count, 1)).SpecialCells(xlCellTypeConstants)
d(A & A.Offset(, 2)) = A.Offset(, 3).Value
Next
With Sheet1 'Original
For Each A In .Range(.[G2], .Cells(.Rows.Count, 7)).SpecialCells(xlCellTypeConstants)
ar = Split(Replace(A.Offset(, 1), " ", ""), ",") 'Color
ay = Split(Replace(A.Offset(, 3), " ", ""), ",") 'Size
For i = 0 To UBound(ar)
y = y + d(Left(A, 7) & ar(i))
Next
For i = 0 To UBound(ay)
x = x + d(Left(A, 7) & Split(ay(i), "-")(0))
Next
A.Offset(, 8) = A & A.Offset(, -1)
A.Offset(, 9).Resize(, 2) = Array(Format(y, "#.##%"), Format(x, "#.##%"))
x = 0: y = 0
Next
End With
End With
End With
End Sub

複製代碼

不清楚第5個問題在描述甚麼?

學海無涯_不恥下問

TOP

sax868

中學生 Rank: 2

帖子: 37
主題: 9
精華: 0
積分: 61
點名: 0
作業系統: Windows7
軟體版本: office 2010
閱讀權限: 20
性別: 女
註冊時間: 2011-4-26
最後登錄: 2014-7-28

5^#

發表於 2012-4-8 15:49 | 只看該作者

Book4.rar (21.33 KB) 回復 3# Hsieh

超級版主您好:

真不好意思，在研究過所有資料後發現遇到一些瓶頸(詳見附件)，可不可以麻煩請超級版主救我?

1. 請問P & Q 欄的值可以設成"百分比"嗎?
2. G欄雖有設End xl Down但只要有空格，數據就停在那不會再往下跑了，請問可以改成如果G欄空格則不跑OPQ值，直到A到N欄都是空白的才停止跑數據嗎?
3. Size (Q欄) 因為特殊值為 "20-inch wheel" 而非其他正常數據(15.5L, 17.5, 20, 22.5, 25) 就跑不出資料，請問可以加設如: 出現"-inch" 則抓"-inch前面的數值嗎?
(因為其相對應的Size/Color工作表裡只顯示"20"而非"20-inch wheel"，所以無法跑數據。對不起!系統資料有點兩光...)
4. Model number (G欄) 第14行多個E (1578601E) 數據為零，請問能否設定Model number 只抓前面七位數字? (因為其相對應的Size/color工作表只顯示數字)
5. 請問是不是有樞紐分析表的行、列就無法跑數據呢? (因為我另存一張表成值就出現數據了!)

感激不盡、萬分感謝！！

弱女子留

TOP

sax868

中學生 Rank: 2

帖子: 37
主題: 9
精華: 0
積分: 61
點名: 0
作業系統: Windows7
軟體版本: office 2010
閱讀權限: 20
性別: 女
註冊時間: 2011-4-26
最後登錄: 2014-7-28

4^#

發表於 2012-4-8 00:02 | 只看該作者

回復 3# Hsieh

:kiss: :handshake
神奇的超級版主，真的太感激您了!!
我的人生終於又變回彩色的囉!!
感恩....

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 155
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2025-6-27

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

3^#

發表於 2012-4-7 19:22 | 只看該作者

回復 2# sax868

Sub ex()
Dim A As Range
Set d = CreateObject("Scripting.Dictionary")
With Sheet2 'Size
For Each A In .Range(.[A2], .[A2].End(xlDown))
d(A & A.Offset(, 2)) = A.Offset(, 3).Value
Next
With Sheet3 'Color
For Each A In .Range(.[A2], .[A2].End(xlDown))
d(A & A.Offset(, 2)) = A.Offset(, 3).Value
Next
With Sheet1 'Original
For Each A In .Range(.[G2], .[G2].End(xlDown))
ar = Split(Replace(A.Offset(, 1), " ", ""), ",") 'Color
ay = Split(Replace(A.Offset(, 3), " ", ""), ",") 'Size
For i = 0 To UBound(ar)
y = y + d(A & ar(i))
Next
For i = 0 To UBound(ay)
x = x + d(A & ay(i))
Next
A.Offset(, 8) = A & A.Offset(, -1)
A.Offset(, 9).Resize(, 2) = Array(y, x)
x = 0: y = 0
Next
End With
End With
End With
End Sub

複製代碼

學海無涯_不恥下問

TOP

sax868

中學生 Rank: 2

帖子: 37
主題: 9
精華: 0
積分: 61
點名: 0
作業系統: Windows7
軟體版本: office 2010
閱讀權限: 20
性別: 女
註冊時間: 2011-4-26
最後登錄: 2014-7-28

2^#

發表於 2012-4-7 18:27 | 只看該作者

Book4.rar (10.67 KB) 回復 1# sax868

對不起...沒傳成功...
請詳見附件!謝謝!!^^

TOP