返回列表 上一主題 發帖

[發問] replace missing value (求救)

本帖最後由 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]

TOP

回復 21# Hsieh

Dear Hsieh版大:

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

TOP

回復 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沒有注意到,再煩請指教
謝謝

TOP

本帖最後由 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.標記 一大題沒寫的(還有空值)的 學號  

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

TOP

回復 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轉換的方法

謝謝 &無限感激

TOP

回復 26# Hsieh


    Dear Hsieh版大:

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

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

TOP

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

回復 28# Hsieh


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


  5. Range("A1").Select
  6.     ActiveCell.FormulaR1C1 = "user"
  7.     Range("B1").Select
  8.     ActiveCell.FormulaR1C1 = "password"


  9.     Dim E As Range
  10.     For Each E In Range("f:f").SpecialCells(xlCellTypeConstants)
  11.         E.Value = "'" & Replace(E, ",", "")
  12.     Next


  13. With [H:BC]
  14. .Replace "*,*", "", xlWhole '清除複選
  15. End With
  16. With [H:BC] '1~48題的欄位


  17. .Replace 1, "3@", xlWhole '將1用一個不常用符號取代


  18. .Replace 2, 1, xlWhole '將2用1取代


  19. .Replace 3, 2, xlWhole '將3用2取代


  20. .Replace "3@", 3, xlWhole '將不常用符號用3取代


  21. End With
  22. Dim A As Range, Ar(), B As Range
  23. Set Upw = CreateObject("Scripting.Dictionary") '帳密
  24. Set dic = CreateObject("Scripting.Dictionary") '參照
  25. fs = ThisWorkbook.Path & "\replace_rule.txt" 'TEXT檔案位置
  26. Close #1 '若已經開啟就先關閉
  27. With Sheets("Sheet0")
  28. Open fs For Input As #1
  29. Do Until EOF(1)
  30.    Line Input #1, mystr
  31.    If InStr(mystr, ",") > 0 Then
  32.    s = InStr(mystr, "(")
  33.    n = InStr(s, mystr, ")")
  34.    mystr = Mid(mystr, s + 1, n - s - 1)
  35.    For Each C In Split(mystr, ",")
  36.      Set A = .Rows(1).Find(C)
  37.      ReDim Preserve Ar(i)
  38.      Ar(i) = Split(A.Address, "$")(1)
  39.      i = i + 1
  40.    Next
  41.    For Each p In Ar
  42.       dic(p) = Ar '記錄公式參照欄位
  43.    Next
  44.    Erase Ar: i = 0
  45.    End If
  46. Loop
  47. Close #1
  48. With Sheets("Sheet1")
  49.   For Each A In .Range(.[A2], .[A2].End(xlDown))
  50.      Upw(CStr(A)) = Array(A.Offset(, 3).Value, A.Offset(, 2).Value) '記錄帳密
  51.   Next
  52. End With
  53. '取代複選位置
  54. Set A = .Range(.[H2], .Cells(.Rows.Count, "CQ").End(xlUp)).Find("*,*")
  55. If Not A Is Nothing Then
  56. Do
  57. ay = Split(A, ",")
  58. For i = 0 To UBound(ay)
  59. ReDim Preserve Ar(i)
  60. Ar(i) = Val(ay(i))
  61. Next
  62.   A.Value = Round(Application.Average(Ar), 0)
  63.   Erase Ar
  64.   Set A = .Range(.[H2], .Cells(.Rows.Count, "CQ").End(xlUp)).Find("*,*", A)
  65. Loop Until A Is Nothing
  66. End If
  67. i = 0
  68. .Select
  69. For Each A In .Range(.[F2], .Cells(.Rows.Count, "F").End(xlUp))
  70.    A.Offset(, -5).Resize(, 2) = Upw(CStr(A)) '填寫帳密
  71.    r = A.Row
  72.    For Each B In .Range(.Cells(r, "H"), .Cells(r, "CQ"))
  73.       If B = "" Then  '找到空格
  74.       ay = dic(Split(B.Address, "$")(1))
  75.       If Not IsEmpty(ay) Then '該儲存格有被公式引用
  76.          For i = 0 To UBound(ay)
  77.          If .Range(ay(i) & r) <> "" Then '引用的參照非空白才計入陣列
  78.            ReDim Preserve Ar(j)
  79.            Ar(j) = ay(i) & r
  80.            j = j + 1
  81.          End If
  82.          Next
  83.         If j > 0 Then B.Value = Round(Application.Evaluate("Average(" & Join(Ar, ",") & ")"), 0)
  84.          Erase Ar
  85.          j = 0
  86.       End If
  87.       End If
  88.     Next
  89. Next
  90. End With

  91. Cells.Select
  92.     Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
  93.         "=(COUNTBLANK($A1:$CQ1)>0)*(COUNTA($A1:$CQ1)>0)"
  94.     Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
  95.     With Selection.FormatConditions(1).Interior
  96.         .PatternColorIndex = xlAutomatic
  97.         .ThemeColor = xlThemeColorAccent6
  98.         .TintAndShade = 0.399945066682943
  99.     End With
  100.     Selection.FormatConditions(1).StopIfTrue = True


  101. End Sub


複製代碼
[attach]16355[/attach]

TOP

本帖最後由 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]

TOP

        靜思自在 : 站在半路,比走到目標更辛苦。
返回列表 上一主題