麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] replace missing value (求救) [打印本頁]

作者: jj369963 時間: 2013-9-19 21:26 標題: replace missing value (求救)

本帖最後由 Hsieh 於 2013-11-15 08:09 編輯

Dear 各位先進大大：

在處理資料遇到需要取代 missing value

問題1：如何找到 missing value 就是blank
問題2：如何取代[attach]16110[/attach]

本來是想用spss來做，但spss只內建5種方法，但都不是我要的計算方式

所以請各位高首先輩
多多指教不才的我

感激
[attach]16110[/attach]

作者: Hsieh 時間: 2013-9-19 22:59

回復 1# jj369963

CP2=SUM(I2,K2,X2,AC2,AF2,AR2,AV2,AZ2)/COUNT(I2,K2,X2,AC2,AF2,AR2,AV2,AZ2)*5/3
以此類推

作者: jj369963 時間: 2013-9-19 23:42

回復 2# Hsieh
謝謝版大回覆：

但是我不是要求cp2的值喔

我是想請問
1.如何在sheet中多筆數值，找出空白(未填答)
2.用公式自動填入原本的空白

但是每題的 missing value 要去填的數值計算有些不一樣

列如

學號1000093，第1題未填答
就把
average(第1題,第10題,第14題,第17題,第26題,第34題,第44題,第46題) 並填入原本未填答的第1題部分

1.因為資料很多筆，用人工方式去找未填答位置，眼睛快花掉
2.要把原本沒有填答的題目用公式幫他填進數值

不好意思，可能我寫得意思，讓人看不懂

再麻煩指教

作者: ML089 時間: 2013-9-21 15:53

回復 3# jj369963
>>學號1000093，第1題有遺漏值，
>>平均(第1題,第10題,第14題,第17題,第26題,第34題,第44題,第46題) ，遺漏值不算
>>
>>average(第1題,第10題,第14題,第17題,第26題,第34題,第44題,第46題)=3.333333
>>四捨五入=3
>>
>>這1格填 3

第1題=空格,第10題=2,第14題=2,第17題=2,第26題=2,第34題=2,第44題=空格,第46題2

疑問1，既然第一題空格要用其他格來求值，就不能放到average中
疑問2，用看的就知道average不會大於2。average(第1題,第10題,第14題,第17題,第26題,第34題,第44題,第46題)=3.333333，看出來你怎樣計算出來的?
疑問3，average項目看不出規律

作者: jj369963 時間: 2013-9-22 12:40

本帖最後由 Hsieh 於 2013-11-15 08:10 編輯

回復 4# ML089

謝謝ML089的回覆：

謝謝您指出的問題，都切中要點
1.確實如果第一題=missing value 就無法放入
2.average(第1題,第10題,第14題,第17題,第26題,第34題,第44題,第46題)=3.333333，確實我算錯了
3.average 的規則(確實沒有一定規則)

MEAN(第4題,第6題,第19題,第24題,第27題,第39題,第43題,第47題)
MEAN(第5題,第7題,第15題,第20題,第22題,第29題,第35題,第40題)
MEAN(第2題,第9題,第12題,第18題,第23題,第28題,第32題,第36題)
MEAN(第3題,第11題,第25題,第30題,第33題,第37題,第41題,第45題)
MEAN(第8題,第13題,第16題,第21題,第31題,第38題,第42題,第48題)
MEAN(第1題,第10題,第14題,第17題,第26題,第34題,第44題,第46題)
MEAN(第74題,第76題,第78題,第80題,第82題)
MEAN(第75題,第77題,第79題,第81題,第83題)
MEAN(第84題,第85題,第86題,第87題,第88題)
MEAN(第52題,第60題,第64題)
MEAN(第57題,第65題,第68題)
MEAN(第56題,第66題,第73題)

問題：在我的檔案裡有漏答的情形，所以想以平均值來取代空值，但是麻煩的是空值不是用1-88題的平均取代，而是依上面規則如第1題是空值，則平均 10,14,17,26,34,44,46，取代第1題空值，如第10題為空值，則平均1,14,17,26,34,44,46，取代第10題空值，如果第56題為空值，則平均 66,73題，取代第56題

本來有想用spss跑，但是spss只提供smean，寫語法一直出錯，無法處理
所以想問各為大大是否excel可以處理呢? 1.找missing value 2.依公式取代missing value
或是有建議的軟體可以處理這樣的情形

感激

如有敘述不清，請見諒
[attach]16123[/attach]

作者: ML089 時間: 2013-9-22 16:33

回復 5# jj369963
最後要求的還是CP2~CU2，直接用公式如下求解，不必大費周章回填空格，這樣反而會使原資料喪失原貌

CP2=(SUM(I2,K2,X2,AC2,AF2,AR2,AV2,AZ2)+ROUND(AVERAGE(I2,K2,X2,AC2,AF2,AR2,AV2,AZ2),0)*(8-COUNT(I2,K2,X2,AC2,AF2,AR2,AV2,AZ2)))/8
CQ2=(SUM(J2,L2,T2,Y2,AA2,AH2,AN2,AS2)+ROUND(AVERAGE(J2,L2,T2,Y2,AA2,AH2,AN2,AS2),0)*(8-COUNT(J2,L2,T2,Y2,AA2,AH2,AN2,AS2)))/8
CR2=(SUM(G2,N2,Q2,W2,AB2,AG2,AK2,AO2)+ROUND(AVERAGE(G2,N2,Q2,W2,AB2,AG2,AK2,AO2),0)*(8-COUNT(G2,N2,Q2,W2,AB2,AG2,AK2,AO2)))/8
CS2=(SUM(H2,P2,AD2,AI2,AL2,AP2,AT2,AX2)+ROUND(AVERAGE(H2,P2,AD2,AI2,AL2,AP2,AT2,AX2),0)*(8-COUNT(H2,P2,AD2,AI2,AL2,AP2,AT2,AX2)))/8
CT2=(SUM(M2,R2,U2,Z2,AJ2,AQ2,AU2,BA2)+ROUND(AVERAGE(M2,R2,U2,Z2,AJ2,AQ2,AU2,BA2),0)*(8-COUNT(M2,R2,U2,Z2,AJ2,AQ2,AU2,BA2)))/8
CU2=(SUM(F2,O2,S2,V2,AE2,AM2,AW2,AY2)+ROUND(AVERAGE(F2,O2,S2,V2,AE2,AM2,AW2,AY2),0)*(8-COUNT(F2,O2,S2,V2,AE2,AM2,AW2,AY2)))/8

作者: Hsieh 時間: 2013-9-22 23:38

回復 5# jj369963
基本上因為CP:CU欄位的公式參照到F:CO欄位
要在F:CO欄的空格內填入CP:CU所得的值，只能對照後填入數值
不可以利用公式填入空格內，因為這會造成循環參照
利用VBA幫助你填入數值才可達成

Sub ex()
Dim Rng As Range, A As Range, C As Range
r = 2
Do Until Cells(r, 1) = ""
Set Rng = Cells(r, 6).Resize(, 88)
If Application.CountA(Rng) < Rng.Count Then
For Each A In Rng.SpecialCells(xlCellTypeBlanks)
For Each C In Range(Cells(r, "CP"), Cells(r, "CU"))
If InStr(C.Formula, A.Address(0, 0)) > 0 Then
A.Value = Round(C, 0)
End If
Next
Next
End If
r = r + 1
Loop
End Sub

複製代碼

作者: jj369963 時間: 2013-9-25 16:26

本帖最後由 Hsieh 於 2013-11-15 08:11 編輯

回復 7# Hsieh

感謝版主：
您真是瞭解我的心意

這就是我想要它運作的結果，但是不好意思，我不會VBA，所以指令有些看不懂

所以不好意思，因為我有80份像這樣的excel要去run，所以想請問是否可以先搜尋空值

因為像 reply_replace missing value_2 檔案的 F80 就沒有被取代，所以.....真是sorry 是否我要一個一個去定位blank的儲存格

另外 missing value 的取代規則如下:
MEAN(第4題,第6題,第19題,第24題,第27題,第39題,第43題,第47題)
MEAN(第5題,第7題,第15題,第20題,第22題,第29題,第35題,第40題)
MEAN(第2題,第9題,第12題,第18題,第23題,第28題,第32題,第36題)
MEAN(第3題,第11題,第25題,第30題,第33題,第37題,第41題,第45題)
MEAN(第8題,第13題,第16題,第21題,第31題,第38題,第42題,第48題)
MEAN(第1題,第10題,第14題,第17題,第26題,第34題,第44題,第46題)
MEAN(第74題,第76題,第78題,第80題,第82題)
MEAN(第75題,第77題,第79題,第81題,第83題)
MEAN(第84題,第85題,第86題,第87題,第88題)
MEAN(第52題,第60題,第64題)
MEAN(第57題,第65題,第68題)
MEAN(第56題,第66題,第73題)

在我的檔案裡有漏答的情形，所以想以平均值來取代空值，但是麻煩的是空值不是用1-88題的平均取代，而是依上面規則如第1題是空值，則平均 10,14,17,26,34,44,46題，取代第1題空值，如第10題為空值，則平均1,14,17,26,34,44,46題，取代第10題空值，如果第56題為空值，則平均 66,73題，取代第56題

所以想問是否excel可以處理呢?
1.找missing value
2.用vba建立常模取代 missing value

另外sorry這樣這個帖是否要放在vba比較適當呢

感激回應

[attach]16162[/attach]

作者: Hsieh 時間: 2013-9-25 17:36

回復 8# jj369963

VBA的作用必須CP:CU欄位都有輸入公式
空格才會對應該列的公式參照填入

作者: jj369963 時間: 2013-9-28 17:45

本帖最後由 Hsieh 於 2013-11-15 08:11 編輯

回復 9# Hsieh

謝謝版主的回覆：

真是愚昧的我，想再請教一個問題，已經在CP:CU欄位都有輸入公式，但是還是沒有取代 missing value 的空格?

另外我用lookup對照帳密，請問這部分是否有辦法可以寫入VBA呢?

感激

再煩請指教

謝謝

[attach]16195[/attach]

作者: Hsieh 時間: 2013-9-29 00:16

回復 10# jj369963

這檔案的空格實在找不出到底隱藏甚麼看不見的字元，所以若使用Application.Counta函數去算數量會找不到空格
只好每格去檢查
再則資料區域改變，變數亦須改變
把帳密檔案與EXCEL檔放在同一目錄，試試

Sub ex()
Dim Rng As Range, A As Range, C As Range
Set dic = CreateObject("Scripting.Dictionary")
fs = ThisWorkbook.Path & "\replace_rule.txt"
Close #1
Open fs For Input As #1
Do Until EOF(1)
Line Input #1, mystr
If InStr(mystr, "=") > 0 Then
n = Application.Match(Trim(Split(mystr, "=")(0)), Rows(1), 0)
x = Split(Replace(Replace(Replace(Replace(Split(mystr, "=")(1), "MEAN(", ""), ")", ""), ".", ""), " ", ""), ",")
For Each ky In x
dic(Trim(ky)) = n
Next
End If
Loop
Close #1
r = 2
Do Until Cells(r, 1) = ""
Set Rng = Cells(r, 8).Resize(, 88) '因為從H欄開始找空格，所以改為Cells(r, 8)
For Each A In Rng
If A = "" Then
k = A.Column
v = Trim(Cells(1, k).Value)
s = dic(v)
A = Cells(r, s)
End If
Next
r = r + 1
Loop
End Sub

複製代碼

作者: jj369963 時間: 2013-10-2 16:07

本帖最後由 Hsieh 於 2013-11-15 08:13 編輯

回復 11# Hsieh

Dear版主大大:

不好意思，不材的我又來求救了，
依您的vba程式確實有跑出來，感激
但是換到其它一樣的檔案試試，就會顯示『找不倒檔案的訊息』，如附檔

另外檔案中 A欄與B欄有用vlookup找帳密，如果可以是否可以寫進VBA裡??

萬分感謝

再煩請指教不才的我

[attach]16220[/attach]

作者: jj369963 時間: 2013-10-2 21:15

回復 11# Hsieh

Dear版主大大:

      您好，忘記說了，是否可以把跑出來的數值再四捨五入(round)變成整數後，再取代mising 值呢?


         再麻煩與上述問題  一同指教

感謝

作者: Hsieh 時間: 2013-10-2 23:35

回復 12# jj369963

找不到檔案的訊息，可能是TXT檔與該EXCEL檔案沒有放在同一個資料夾內
因為我測試時並無此情況發生，只是發現若該空格的參照並未被右側公式所引用時就會出錯
試試以下程式碼看看

Sub ex()
Dim Rng As Range, A As Range, C As Range
Set dic = CreateObject("Scripting.Dictionary")
Set dic1 = CreateObject("Scripting.Dictionary")
fs = ThisWorkbook.Path & "\replace_rule.txt"
Close #1
Open fs For Input As #1
Do Until EOF(1)
Line Input #1, mystr
If InStr(mystr, "=") > 0 Then
n = Application.Match(Trim(Split(mystr, "=")(0)), Rows(1), 0)
x = Split(Replace(Replace(Replace(Replace(Split(mystr, "=")(1), "MEAN(", ""), ")", ""), ".", ""), " ", ""), ",")
For Each ky In x
dic(Trim(ky)) = n
Next
End If
Loop
Close #1
With Sheet2
For Each A In .Range(.[A2], .[A2].End(xlDown))
dic1(A.Value) = Array(A.Offset(, 2).Value, A.Offset(, 3).Value) '紀錄帳密
Next
End With
r = 2
With Sheets("Sheet0")
Do Until .Cells(r, 1) = ""
.Cells(r, 1).Resize(, 2) = dic1(.Cells(r, 6).Value) '填入帳密
Set Rng = .Cells(r, 8).Resize(, 88) '因為從H欄開始找空格，所以改為.Cells(r, 8)
For Each A In Rng
If A = "" Then
k = A.Column
v = Trim(.Cells(1, k).Value)
s = dic(v)
If s <> "" Then A = Round(.Cells(r, s), 0) Else: A = "無引用" '如果空格有被公式參照則填入數值，無則填入"無引用"字串
End If
Next
r = r + 1
Loop
End With
End Sub

複製代碼

作者: jj369963 時間: 2013-10-3 16:42

本帖最後由 Hsieh 於 2013-11-15 08:13 編輯

回復 14# Hsieh

Dear版主大大:
               謝謝大大的回應，非常感謝，用了上述公式用在同ㄧ檔案成功了。真是amazing感謝。
         但是ㄧ波未平一波又起，用再另一個檔案卻又出現問題了，如附檔。所以又厚臉皮來求救了，  真是的我><

   另外，因為類似的檔案有近百個，其中有重複做答，所以困難度加深了
      1.  需先處理 cell裡重複作答的數字部份，英文不用
            cell裡的數字，如果複選會用逗點隔開，如(1,2,3,4,5) 是否可以先把複選的cell平均後(1+2+3+4+5)，並round四捨五入填入，不知這樣可行嗎?

      2.之後再找missing value ，直接依 replace_rule.txt 公式做取代
         另外如果可以是否可以不要參照excel的CR 到DC欄，直接依 replace_rule.txt
         因為其實　R　I　Ａ　S　Ｅ　C　是還要乘以5/3，也就是(excel上)
         R = MEAN(第4題,第6題,第19題,第24題,第27題,第39題,第43題,第47題) *5/3
         I = MEAN(第5題,第7題,第15題,第20題,第22題,第29題,第35題,第40題) *5/3
         A = MEAN(第2題,第9題,第12題,第18題,第23題,第28題,第32題,第36題) *5/3
         S = MEAN(第3題,第11題,第25題,第30題,第33題,第37題,第41題,第45題) *5/3
         E = MEAN(第8題,第13題,第16題,第21題,第31題,第38題,第42題,第48題) *5/3
         C = MEAN(第1題,第10題,第14題,第17題,第26題,第34題,第44題,第46題) *5/3

         但是因為要對應  取代missing value 是沒有乘以5/3，也就是
         R = MEAN(第4題,第6題,第19題,第24題,第27題,第39題,第43題,第47題)
         I = MEAN(第5題,第7題,第15題,第20題,第22題,第29題,第35題,第40題)
         A = MEAN(第2題,第9題,第12題,第18題,第23題,第28題,第32題,第36題)
         S = MEAN(第3題,第11題,第25題,第30題,第33題,第37題,第41題,第45題)
         E = MEAN(第8題,第13題,第16題,第21題,第31題,第38題,第42題,第48題)
         C = MEAN(第1題,第10題,第14題,第17題,第26題,第34題,第44題,第46題)
            所以如果可以是否可以不要參照excel的CR 到DC欄，直接依 replace_rule.txt ，不知這樣可行嗎?

      3.最後帳密的部份，請問是否可以直接把vlookup公式寫入(不再貼公式)，也就是在sheet1放帳密資訊，對照到
         sheet0的user與 password欄位，最後再進行錄製，不知這樣可行嗎?

         其實問題還蠻難的，所以想問可行度，當然如果不行，也希望多給建議(越來越覺得自己太厚臉皮了)
         最後感謝版主大大每次都超級期待您的回信，深深感激

         最後再麻煩回應指教，感謝
                                             [attach]16232[/attach]

作者: jj369963 時間: 2013-10-4 10:15

回復 14# Hsieh

Dear版主大大:
   不好意思，又來叨擾。
   根據上一篇的
   1.  需先處理 cell裡重複作答的數字部份，英文不用
            cell裡的數字，如果複選會用逗點隔開，如(1,2,3,4,5) 是否可以先把複選的cell平均後(1+2+3+4+5)，並round四捨五入填入，
        因為我覺得太困難了，改成  把複選作答清空當成missing值，這樣是否比較簡單?? 如果vba無法複選平均，那是否可以清空複選當missing

   2.  之後再找missing value ，直接依 replace_rule.txt 公式做取代
         另外如果可以是否可以不要參照excel的CR 到DC欄，直接依 replace_rule.txt ???
            回覆:但是如果VBA無法直接參照replace_rule.txt，就是還是需要參照excel的CR 到DC欄，那就依原本的

      3.最後帳密的部份，請問是否可以直接把vlookup公式寫入(不再貼公式)，也就是在sheet1放帳密資訊，對照到
         sheet0的user與 password欄位，最後再進行錄製，不知這樣可行嗎?

            回覆:  把vlookup公式寫入(不再貼公式)，也就是在sheet1放帳密資訊，對照到
         sheet0的user與 password欄位，這部份不需要，依原本的錄製帳密即可

                  主要是針對第1點的複選處理，希望大大予以協助或建議
               真是抱歉百忙叨擾，再請多指教
                        萬分感謝

作者: Hsieh 時間: 2013-10-7 15:15

回復 16# jj369963

試試看

Sub Replace_Blank()
Dim A As Range, Ar(), B As Range
Set Upw = CreateObject("Scripting.Dictionary") '帳密
Set dic = CreateObject("Scripting.Dictionary") '帳密
fs = ThisWorkbook.Path & "\replace_rule.txt" 'TEXT檔案位置
Close #1 '若已經開啟就先關閉
With Sheet1
Open fs For Input As #1
Do Until EOF(1)
Line Input #1, mystr
If InStr(mystr, ",") > 0 Then
s = InStr(mystr, "(")
n = InStr(s, mystr, ")")
mystr = Mid(mystr, s + 1, n - s - 1)
For Each C In Split(mystr, ",")
Set A = .Rows(1).Find(C)
ReDim Preserve Ar(i)
Ar(i) = Split(A.Address, "$")(1)
i = i + 1
Next
For Each p In Ar
dic(p) = Ar '記錄公式參照欄位
Next
Erase Ar: i = 0
End If
Loop
Close #1
With 工作表1
For Each A In .Range(.[A2], .[A2].End(xlDown))
Upw(CStr(A)) = Array(A.Offset(, 3).Value, A.Offset(, 2).Value) '記錄帳密
Next
End With
'取代複選位置
Set A = .Range(.[H2], .Cells(.Rows.Count, "CQ").End(xlUp)).Find("*,*")
If Not A Is Nothing Then
Do
ay = Split(A, ",")
For i = 0 To UBound(ay)
ReDim Preserve Ar(i)
Ar(i) = CInt(ay(i))
Next
A.Value = Round(Application.Average(Ar), 0)
Erase Ar
Set A = .Range(.[H2], .Cells(.Rows.Count, "CQ").End(xlUp)).Find("*,*", A)
Loop Until A Is Nothing
End If
i = 0
.Select
For Each A In .Range(.[F2], .Cells(.Rows.Count, "F").End(xlUp))
A.Offset(, -5).Resize(, 2) = Upw(CStr(A)) '填寫帳密
r = A.Row
For Each B In .Range(.Cells(r, "H"), .Cells(r, "CQ"))
If B = "" Then '找到空格
ay = dic(Split(B.Address, "$")(1))
If Not IsEmpty(ay) Then '該儲存格有被公式引用
For i = 0 To UBound(ay)
ReDim Preserve Ar(i)
Ar(i) = ay(i) & r
Next
If Application.Count(.Range(Join(Ar, ","))) > 0 Then B.Value = Round(Application.Evaluate("Average(" & Join(Ar, ",") & ")*5/3"), 0)
Erase Ar
End If
End If
Next
Next
End With
End Sub

複製代碼

作者: jj369963 時間: 2013-10-7 22:34

本帖最後由 Hsieh 於 2013-11-15 08:14 編輯

回復 17# Hsieh

Dear  Hsieh 版大：

  太感激您的回覆，淚奔，也多謝您的費心

but 又要勞煩您看一下，run的時候出現錯誤了

跳出的錯誤視窗如附檔

我知道如果cell有  #N/A ，再跑vba好像都會有錯誤視窗跳出

目前已把會出現  #N/A 設為空白，但是跑vba還是又出錯了

另外　套入取代missing 的 R　I　Ａ　S　Ｅ　C是不要*5/3但四捨五入，
               而CR欄到CW欄的  R　I　Ａ　S　Ｅ　C　是要乘以5/3

不過最主要的還是把複數題變成missing值，再依規則取代

三番兩次打擾真是不好意思

再麻煩您指教了

謝謝

[attach]16267[/attach]

作者: Hsieh 時間: 2013-10-8 13:44

回復 18# jj369963

不懂你所說

另外　套入取代missing 的 R　I　Ａ　S　Ｅ　C是不要*5/3但四捨五入，
而CR欄到CW欄的 R　I　Ａ　S　Ｅ　C　是要乘以5/3

程式碼執行已經不需要有CR:DC欄位的公式，你驗算看看差異在哪?

Sub Replace_Blank()
Dim A As Range, Ar(), B As Range
Set Upw = CreateObject("Scripting.Dictionary") '帳密
Set dic = CreateObject("Scripting.Dictionary") '參照
fs = ThisWorkbook.Path & "\replace_rule.txt" 'TEXT檔案位置
Close #1 '若已經開啟就先關閉
With Sheets("Sheet0")
Open fs For Input As #1
Do Until EOF(1)
Line Input #1, mystr
If InStr(mystr, ",") > 0 Then
s = InStr(mystr, "(")
n = InStr(s, mystr, ")")
mystr = Mid(mystr, s + 1, n - s - 1)
For Each C In Split(mystr, ",")
Set A = .Rows(1).Find(C)
ReDim Preserve Ar(i)
Ar(i) = Split(A.Address, "$")(1)
i = i + 1
Next
For Each p In Ar
dic(p) = Ar '記錄公式參照欄位
Next
Erase Ar: i = 0
End If
Loop
Close #1
With Sheets("Sheet1")
For Each A In .Range(.[A2], .[A2].End(xlDown))
Upw(CStr(A)) = Array(A.Offset(, 3).Value, A.Offset(, 2).Value) '記錄帳密
Next
End With
'取代複選位置
Set A = .Range(.[H2], .Cells(.Rows.Count, "CQ").End(xlUp)).Find("*,*")
If Not A Is Nothing Then
Do
ay = Split(A, ",")
For i = 0 To UBound(ay)
ReDim Preserve Ar(i)
Ar(i) = Val(ay(i))
Next
A.Value = Round(Application.Average(Ar), 0)
Erase Ar
Set A = .Range(.[H2], .Cells(.Rows.Count, "CQ").End(xlUp)).Find("*,*", A)
Loop Until A Is Nothing
End If
i = 0
.Select
For Each A In .Range(.[F2], .Cells(.Rows.Count, "F").End(xlUp))
A.Offset(, -5).Resize(, 2) = Upw(CStr(A)) '填寫帳密
r = A.Row
For Each B In .Range(.Cells(r, "H"), .Cells(r, "CQ"))
If B = "" Then '找到空格
ay = dic(Split(B.Address, "$")(1))
If Not IsEmpty(ay) Then '該儲存格有被公式引用
For i = 0 To UBound(ay)
ReDim Preserve Ar(i)
Ar(i) = ay(i) & r
Next
If Application.Count(.Range(Join(Ar, ","))) > 0 Then B.Value = Round(Application.Evaluate("Average(" & Join(Ar, ",") & ")*5/3"), 0)
Erase Ar
End If
End If
Next
Next
End With
End Sub

複製代碼

作者: jj369963 時間: 2013-10-8 22:32

本帖最後由 Hsieh 於 2013-11-15 08:14 編輯

回復 19# Hsieh

Dear  Hsieh 版大：

感謝您的回覆，it works非常的感動.  我測試後，程式碼執行確實已經不需要有CR:DC欄位的公式。

but 計算的結果有點小問題  第1題到第48題只能是1或2或3       所以平均出來不可能是4或5 (但是現在run的結果卻跑出4或5)

規則是：
MEAN(第4題,第6題,第19題,第24題,第27題,第39題,第43題,第47題)
MEAN(第5題,第7題,第15題,第20題,第22題,第29題,第35題,第40題)
MEAN(第2題,第9題,第12題,第18題,第23題,第28題,第32題,第36題)
MEAN(第3題,第11題,第25題,第30題,第33題,第37題,第41題,第45題)
MEAN(第8題,第13題,第16題,第21題,第31題,第38題,第42題,第48題)
MEAN(第1題,第10題,第14題,第17題,第26題,第34題,第44題,第46題)
MEAN(第74題,第76題,第78題,第80題,第82題)
MEAN(第75題,第77題,第79題,第81題,第83題)
MEAN(第84題,第85題,第86題,第87題,第88題)
MEAN(第52題,第60題,第64題)
MEAN(第57題,第65題,第68題)
MEAN(第56題,第66題,第73題)

也就是第4題missing 就平均第6題,第19題,第24題,第27題,第39題,第43題,第47題，取四捨五入
            第6題,第19題 missing 就平均第4題,第24題,第27題,第39題,第43題,第47題，取四捨五入

就是一組裡，如果有missing值就平均其他值，再取代

目前我測試第1題 missing
                  第10題=2
                     第14題=2
                     第17題=2
                     第26題=1
                     第34題=1
                     第44題 =2
                     第46題=2
所以第一題=round(average(2,2,2,1,1,2,2)=1.714285714=2

但是執行vba跑出來是  第一題= 3

現在跑出來第1題H2=3，第20題 AA10=4 ，  第30題AK27=5

所以計算結果數值是有問題的

可以再麻煩您看一下嗎?  真是抱歉一直打擾，再麻煩您指教
謝謝

附註：您之前的回覆『回復 12』，計算出來的結果是對的

[attach]16273[/attach]

作者: Hsieh 時間: 2013-10-9 21:37

回復 20# jj369963
所以並不需要*5/3嗎?

Sub Replace_Blank()
Dim A As Range, Ar(), B As Range
Set Upw = CreateObject("Scripting.Dictionary") '帳密
Set dic = CreateObject("Scripting.Dictionary") '參照
fs = ThisWorkbook.Path & "\replace_rule.txt" 'TEXT檔案位置
Close #1 '若已經開啟就先關閉
With Sheets("Sheet0")
Open fs For Input As #1
Do Until EOF(1)
Line Input #1, mystr
If InStr(mystr, ",") > 0 Then
s = InStr(mystr, "(")
n = InStr(s, mystr, ")")
mystr = Mid(mystr, s + 1, n - s - 1)
For Each C In Split(mystr, ",")
Set A = .Rows(1).Find(C)
ReDim Preserve Ar(i)
Ar(i) = Split(A.Address, "$")(1)
i = i + 1
Next
For Each p In Ar
dic(p) = Ar '記錄公式參照欄位
Next
Erase Ar: i = 0
End If
Loop
Close #1
With Sheets("Sheet1")
For Each A In .Range(.[A2], .[A2].End(xlDown))
Upw(CStr(A)) = Array(A.Offset(, 3).Value, A.Offset(, 2).Value) '記錄帳密
Next
End With
'取代複選位置
Set A = .Range(.[H2], .Cells(.Rows.Count, "CQ").End(xlUp)).Find("*,*")
If Not A Is Nothing Then
Do
ay = Split(A, ",")
For i = 0 To UBound(ay)
ReDim Preserve Ar(i)
Ar(i) = Val(ay(i))
Next
A.Value = Round(Application.Average(Ar), 0)
Erase Ar
Set A = .Range(.[H2], .Cells(.Rows.Count, "CQ").End(xlUp)).Find("*,*", A)
Loop Until A Is Nothing
End If
i = 0
.Select
For Each A In .Range(.[F2], .Cells(.Rows.Count, "F").End(xlUp))
A.Offset(, -5).Resize(, 2) = Upw(CStr(A)) '填寫帳密
r = A.Row
For Each B In .Range(.Cells(r, "H"), .Cells(r, "CQ"))
If B = "" Then '找到空格
ay = dic(Split(B.Address, "$")(1))
If Not IsEmpty(ay) Then '該儲存格有被公式引用
For i = 0 To UBound(ay)
If .Range(ay(i) & r) <> "" Then '引用的參照非空白才計入陣列
ReDim Preserve Ar(j)
Ar(j) = ay(i) & r
j = j + 1
End If
Next
If j > 0 Then B.Value = Round(Application.Evaluate("Average(" & Join(Ar, ",") & ")"), 0)
Erase Ar
j = 0
End If
End If
Next
Next
End With
End Sub

複製代碼

作者: jj369963 時間: 2013-10-9 23:49

回復 21# Hsieh

Dear Hsieh版大：

         真是感謝再感謝，擾您費心了(真是費很多心)。著實覺得感動想在心中呼喊
         works successfully
         如果不介意想再請教一個問題，對不起又給您出題了
      如果想在跑完之後，去檢查每一列中還有空白的(就是沒有被程式取代)，因為整大題沒寫，缺失值過多，像這樣的資料那一列，以下依難易度，選擇其一處理：
         1.列有空白值，學號標記顏色
         2.列有空白值，將該列排序於最後(就是要複製該列，貼於最後，又刪除原本的列)
         3.列有空白值，將該列剪下，貼至其他sheet

         真是大大不好意思，再請指教
      感謝

作者: jj369963 時間: 2013-10-10 07:49

回復 21# Hsieh

Dear Hsieh版大：

感謝您費心的指導，取代時不需要*5/3

but 昨天半夜發現到一個問題，有反向題，我的天
所以又來請益
就是在第1題到第48題
原本答案是  1 convert to 3  (1改3)
                     2 convert to 1  (2改1)
                     3 convert to  2 (3改2)
                        複選就清空
之後依規則取代空值

真是sorry沒有注意到，再煩請指教
謝謝

作者: jj369963 時間: 2013-10-10 16:48

本帖最後由 jj369963 於 2013-10-10 16:50 編輯

回復 21# Hsieh

Dear Hsieh版大：

  真是sorry，我的腦袋已經混亂了。還造成麻煩真是抱歉，重新思考整個邏輯順序，應該是這樣：

1.清空複選
2. 在第1題到第48題
   原本答案是  1 convert to 3  (1改3)
                           2 convert to 1  (2改1)
                           3 convert to  2 (3改2)
3.再依規則取代，不需要*5/3，程式碼執行不需要有CR:DC欄位的公式
4.標記一大題沒寫的(還有空值)的學號

真是抱歉一直打擾，再麻煩您指教
謝謝

作者: jj369963 時間: 2013-10-13 20:45

回復 21# Hsieh

Dear Hsieh版大：

   又來討教，真不好意思，目前針對第1題到第48題的轉換
原本答案是  1 convert to 3  (1改3)
                     2 convert to 1  (2改1)
                     3 convert to  2 (3改2)

  想到的是 =IF(H2=1,3,IF(H2=2,1,IF(H2=3,2,""))) 往右往下，但是用公式無法取代原本cell ，不知是否可以用vba?

或是以下語法(不知道vba適用下列語法嗎)

RECODE
  第1題第2題第3題第4題第5題第6題第7題第8題第9題第10題第11題第12題第13題第14題第15題第16題第17題第18題第19題
  第20題第21題第22題第23題第24題第25題第26題第27題第28題第29題第30題第31題第32題第33題第34題第35題第36題
  第37題第38題第39題第40題第41題第42題第43題第44題第45題第46題第47題第48題  (1=3)  (2=1)  (3=2)  .
EXECUTE .

再煩請指教變數直接在cell轉換的方法

謝謝 &無限感激

作者: Hsieh 時間: 2013-10-14 09:17

回復 25# jj369963

With [H:BC] '1~48題的欄位
.Replace 1, "3@", xlWhole '將1用一個不常用符號取代
.Replace 2, 1, xlWhole '將2用1取代
.Replace 3, 2, xlWhole '將3用2取代
.Replace "3@", 3, xlWhole '將不常用符號用3取代
End With

複製代碼

作者: jj369963 時間: 2013-10-14 13:20

回復 26# Hsieh

Dear Hsieh版大：

謝謝您熱心的回覆，非常感激，原來技巧是『用一個不常用符號取代』，真是妙，感謝。
另外想再請教一個問題(我怎麼有無數的問題呀，天呀)
之前看文章我知道vba可以搜尋關鍵字，並顏色標記整列
我的意思是
整個資料全部處理完後，還是有missing(因為無公式可以對應取代)，所以是否可以
在A-CQ欄搜尋missing ，並將整列標記顏色(黃色)，舉例如果A15為空值，就將第15列全部標顏色，依此類推

亦或是將還有空值的整列移到別的sheet,如sheet2 ->這樣的方式不知是否可以用vba??

再煩請大大，多多指教
再次感謝

作者: Hsieh 時間: 2013-10-16 08:38

回復 27# jj369963

整個資料全部處理完後，還是有missing(因為無公式可以對應取代)，所以是否可以
在A-CQ欄搜尋missing ，並將整列標記顏色(黃色)，舉例如果A15為空值，就將第15列全部標顏色，依此類推

標顏色用格式化條件即可達成
=(COUNTBLANK($A1:$CQ1)>0)*(COUNTA($A1:$CQ1)>0)
[attach]16348[/attach]

作者: jj369963 時間: 2013-10-16 17:16

本帖最後由 Hsieh 於 2013-11-16 22:48 編輯

回復 28# Hsieh

Dear Hsieh大大：
                                 非常感謝您的回覆，原來用點邏輯，並藉由格式劃設定即可做到，感激。
                                 第一次學習VBA，還搞不清狀況的說，真的很感謝您的指導。我稍微修改一下如下語法：
                              但是我想再請問一個問題，因為我的原始檔案是字串，我想改成數值  從D欄到CO欄，我知道可以改儲存格格式，或手動按鈕轉數值，
                           但還是忍不住想請教一下如何可以用vba把文字轉成數值，如附檔，再請多指教，
                           另外真得很感謝您讓我知道VBA得好玩有趣。

Sub Replace_Blank()
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Range("A1").Select
ActiveCell.FormulaR1C1 = "user"
Range("B1").Select
ActiveCell.FormulaR1C1 = "password"
Dim E As Range
For Each E In Range("f:f").SpecialCells(xlCellTypeConstants)
E.Value = "'" & Replace(E, ",", "")
Next
With [H:BC]
.Replace "*,*", "", xlWhole '清除複選
End With
With [H:BC] '1~48題的欄位
.Replace 1, "3@", xlWhole '將1用一個不常用符號取代
.Replace 2, 1, xlWhole '將2用1取代
.Replace 3, 2, xlWhole '將3用2取代
.Replace "3@", 3, xlWhole '將不常用符號用3取代
End With
Dim A As Range, Ar(), B As Range
Set Upw = CreateObject("Scripting.Dictionary") '帳密
Set dic = CreateObject("Scripting.Dictionary") '參照
fs = ThisWorkbook.Path & "\replace_rule.txt" 'TEXT檔案位置
Close #1 '若已經開啟就先關閉
With Sheets("Sheet0")
Open fs For Input As #1
Do Until EOF(1)
Line Input #1, mystr
If InStr(mystr, ",") > 0 Then
s = InStr(mystr, "(")
n = InStr(s, mystr, ")")
mystr = Mid(mystr, s + 1, n - s - 1)
For Each C In Split(mystr, ",")
Set A = .Rows(1).Find(C)
ReDim Preserve Ar(i)
Ar(i) = Split(A.Address, "$")(1)
i = i + 1
Next
For Each p In Ar
dic(p) = Ar '記錄公式參照欄位
Next
Erase Ar: i = 0
End If
Loop
Close #1
With Sheets("Sheet1")
For Each A In .Range(.[A2], .[A2].End(xlDown))
Upw(CStr(A)) = Array(A.Offset(, 3).Value, A.Offset(, 2).Value) '記錄帳密
Next
End With
'取代複選位置
Set A = .Range(.[H2], .Cells(.Rows.Count, "CQ").End(xlUp)).Find("*,*")
If Not A Is Nothing Then
Do
ay = Split(A, ",")
For i = 0 To UBound(ay)
ReDim Preserve Ar(i)
Ar(i) = Val(ay(i))
Next
A.Value = Round(Application.Average(Ar), 0)
Erase Ar
Set A = .Range(.[H2], .Cells(.Rows.Count, "CQ").End(xlUp)).Find("*,*", A)
Loop Until A Is Nothing
End If
i = 0
.Select
For Each A In .Range(.[F2], .Cells(.Rows.Count, "F").End(xlUp))
A.Offset(, -5).Resize(, 2) = Upw(CStr(A)) '填寫帳密
r = A.Row
For Each B In .Range(.Cells(r, "H"), .Cells(r, "CQ"))
If B = "" Then '找到空格
ay = dic(Split(B.Address, "$")(1))
If Not IsEmpty(ay) Then '該儲存格有被公式引用
For i = 0 To UBound(ay)
If .Range(ay(i) & r) <> "" Then '引用的參照非空白才計入陣列
ReDim Preserve Ar(j)
Ar(j) = ay(i) & r
j = j + 1
End If
Next
If j > 0 Then B.Value = Round(Application.Evaluate("Average(" & Join(Ar, ",") & ")"), 0)
Erase Ar
j = 0
End If
End If
Next
Next
End With
Cells.Select
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=(COUNTBLANK($A1:$CQ1)>0)*(COUNTA($A1:$CQ1)>0)"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.399945066682943
End With
Selection.FormatConditions(1).StopIfTrue = True
End Sub

複製代碼

[attach]16355[/attach]

作者: jj369963 時間: 2013-10-23 15:55

本帖最後由 Hsieh 於 2013-11-15 08:12 編輯

回復 21# Hsieh

DEAR Hsieh 版大：

      SORRY，又來打擾，套用公式後，會發現其中

         好奇籌劃 = MEAN(第52題,第60題,第64題)
         希望立命 = MEAN(第57題,第65題,第68題)
            安在處境 = MEAN(第56題,第66題,第73題)
            有時並沒有依照公式四捨五入
如檔案(第二列)
第57題=MISSING
第65題=4
第68題)=5
所以第57題=(4+5)/2=4.5=5  但出來的結果是第57題=4

同理(第二列)
第52題=5
第60題=MISSING
第64題=4

所以第60題=(4+5)/2=4.5=5  但出來的結果是第60題=4

但語法已有ROUND
If j > 0 Then B.Value = Round(Application.Evaluate("Average(" & Join(Ar, ",") & ")"), 0)

因為找不到round錯誤的原因，所以又來請益，

再煩請多指教，謝謝。

[attach]16459[/attach]

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