123
返回列表 上一主題 發帖

[發問] replace missing value (求救)

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
11# 跳轉到 »
發表於 2013-9-29 00:16 | 只看該作者
回復 10# jj369963

這檔案的空格實在找不出到底隱藏甚麼看不見的字元，所以若使用Application.Counta函數去算數量會找不到空格
只好每格去檢查
再則資料區域改變，變數亦須改變
把帳密檔案與EXCEL檔放在同一目錄，試試
  1. Sub ex()
  2. Dim Rng As Range, A As Range, C As Range
  3. Set dic = CreateObject("Scripting.Dictionary")
  4. fs = ThisWorkbook.Path & "\replace_rule.txt"
  5. Close #1

  7. Open fs For Input As #1
  8. Do Until EOF(1)
  9.   Line Input #1, mystr
  10.   If InStr(mystr, "=") > 0 Then
  11.   n = Application.Match(Trim(Split(mystr, "=")(0)), Rows(1), 0)
  12.   x = Split(Replace(Replace(Replace(Replace(Split(mystr, "=")(1), "MEAN(", ""), ")", ""), ".", ""), " ", ""), ",")
  13.   For Each ky In x
  14.     dic(Trim(ky)) = n
  15.   Next
  16.   End If
  17. Loop
  18. Close #1
  19. r = 2
  20. Do Until Cells(r, 1) = ""
  21.   Set Rng = Cells(r, 8).Resize(, 88) '因為從H欄開始找空格，所以改為Cells(r, 8)
  22.   For Each A In Rng
  23.   If A = "" Then
  24.   k = A.Column
  25.   v = Trim(Cells(1, k).Value)
  26.   s = dic(v)
  27.   A = Cells(r, s)
  28.   End If
  29.   Next
  30. r = r + 1
  31. Loop
  32. End Sub
複製代碼
學海無涯_不恥下問

TOP

jj369963

帖子
147 
主題
46 
精華
0 
積分
205 
點名
0  
作業系統
windows xp 
軟體版本
office 2003 
閱讀權限
20 
性別
女 
註冊時間
2012-3-19 
最後登錄
2021-5-21 
12#
發表於 2013-10-2 16:07 | 只看該作者
本帖最後由 Hsieh 於 2013-11-15 08:13 編輯

回復 11# Hsieh


    Dear版主大大:

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

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

萬分感謝

再煩請指教不才的我

[attach]16220[/attach]

TOP

jj369963

帖子
147 
主題
46 
精華
0 
積分
205 
點名
0  
作業系統
windows xp 
軟體版本
office 2003 
閱讀權限
20 
性別
女 
註冊時間
2012-3-19 
最後登錄
2021-5-21 
13#
發表於 2013-10-2 21:15 | 只看該作者
回復 11# Hsieh


   Dear版主大大:

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

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

感謝

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
14#
發表於 2013-10-2 23:35 | 只看該作者
回復 12# jj369963


    找不到檔案的訊息，可能是TXT檔與該EXCEL檔案沒有放在同一個資料夾內
因為我測試時並無此情況發生，只是發現若該空格的參照並未被右側公式所引用時就會出錯
試試以下程式碼看看
  1. Sub ex()
  2. Dim Rng As Range, A As Range, C As Range
  3. Set dic = CreateObject("Scripting.Dictionary")
  4. Set dic1 = CreateObject("Scripting.Dictionary")

  6. fs = ThisWorkbook.Path & "\replace_rule.txt"
  7. Close #1

  9. Open fs For Input As #1
  10. Do Until EOF(1)
  11.   Line Input #1, mystr
  12.   If InStr(mystr, "=") > 0 Then
  13.   n = Application.Match(Trim(Split(mystr, "=")(0)), Rows(1), 0)
  14.   x = Split(Replace(Replace(Replace(Replace(Split(mystr, "=")(1), "MEAN(", ""), ")", ""), ".", ""), " ", ""), ",")
  15.   For Each ky In x
  16.     dic(Trim(ky)) = n
  17.   Next
  18.   End If
  19. Loop
  20. Close #1
  21. With Sheet2
  22. For Each A In .Range(.[A2], .[A2].End(xlDown))
  23.    dic1(A.Value) = Array(A.Offset(, 2).Value, A.Offset(, 3).Value) '紀錄帳密
  24. Next
  25. End With
  26. r = 2
  27. With Sheets("Sheet0")
  28. Do Until .Cells(r, 1) = ""
  29. .Cells(r, 1).Resize(, 2) = dic1(.Cells(r, 6).Value) '填入帳密
  30.   Set Rng = .Cells(r, 8).Resize(, 88) '因為從H欄開始找空格，所以改為.Cells(r, 8)
  31.   For Each A In Rng
  32.   If A = "" Then
  33.   k = A.Column
  34.   v = Trim(.Cells(1, k).Value)
  35.   s = dic(v)
  36.   If s <> "" Then A = Round(.Cells(r, s), 0) Else: A = "無引用" '如果空格有被公式參照則填入數值，無則填入"無引用"字串
  37.   End If
  38.   Next
  39. r = r + 1
  40. Loop
  41. End With
  42. End Sub
複製代碼
學海無涯_不恥下問

TOP

jj369963

帖子
147 
主題
46 
精華
0 
積分
205 
點名
0  
作業系統
windows xp 
軟體版本
office 2003 
閱讀權限
20 
性別
女 
註冊時間
2012-3-19 
最後登錄
2021-5-21 
15#
發表於 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]

TOP

jj369963

帖子
147 
主題
46 
精華
0 
積分
205 
點名
0  
作業系統
windows xp 
軟體版本
office 2003 
閱讀權限
20 
性別
女 
註冊時間
2012-3-19 
最後登錄
2021-5-21 
16#
發表於 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點 的複選處理，希望大大予以協助或建議
                   真是抱歉百忙叨擾，再請多指教
                           萬分感謝

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
17#
發表於 2013-10-7 15:15 | 只看該作者
回復 16# jj369963

試試看
  1. Sub Replace_Blank()
  2. Dim A As Range, Ar(), B As Range
  3. Set Upw = CreateObject("Scripting.Dictionary") '帳密
  4. Set dic = CreateObject("Scripting.Dictionary") '帳密
  5. fs = ThisWorkbook.Path & "\replace_rule.txt" 'TEXT檔案位置
  6. Close #1 '若已經開啟就先關閉
  7. With Sheet1
  8. Open fs For Input As #1
  9. Do Until EOF(1)
  10.    Line Input #1, mystr
  11.    If InStr(mystr, ",") > 0 Then
  12.    s = InStr(mystr, "(")
  13.    n = InStr(s, mystr, ")")
  14.    mystr = Mid(mystr, s + 1, n - s - 1)
  15.    For Each C In Split(mystr, ",")
  16.      Set A = .Rows(1).Find(C)
  17.      ReDim Preserve Ar(i)
  18.      Ar(i) = Split(A.Address, "$")(1)
  19.      i = i + 1
  20.    Next
  21.    For Each p In Ar
  22.       dic(p) = Ar '記錄公式參照欄位
  23.    Next
  24.    Erase Ar: i = 0
  25.    End If
  26. Loop
  27. Close #1
  28. With 工作表1
  29.   For Each A In .Range(.[A2], .[A2].End(xlDown))
  30.      Upw(CStr(A)) = Array(A.Offset(, 3).Value, A.Offset(, 2).Value) '記錄帳密
  31.   Next
  32. End With
  33. '取代複選位置
  34. Set A = .Range(.[H2], .Cells(.Rows.Count, "CQ").End(xlUp)).Find("*,*")
  35. If Not A Is Nothing Then
  36. Do
  37. ay = Split(A, ",")
  38. For i = 0 To UBound(ay)
  39. ReDim Preserve Ar(i)
  40. Ar(i) = CInt(ay(i))
  41. Next
  42.   A.Value = Round(Application.Average(Ar), 0)
  43.   Erase Ar
  44.   Set A = .Range(.[H2], .Cells(.Rows.Count, "CQ").End(xlUp)).Find("*,*", A)
  45. Loop Until A Is Nothing
  46. End If
  47. i = 0
  48. .Select
  49. For Each A In .Range(.[F2], .Cells(.Rows.Count, "F").End(xlUp))
  50.    A.Offset(, -5).Resize(, 2) = Upw(CStr(A)) '填寫帳密
  51.    r = A.Row
  52.    For Each B In .Range(.Cells(r, "H"), .Cells(r, "CQ"))
  53.       If B = "" Then  '找到空格
  54.       ay = dic(Split(B.Address, "$")(1))
  55.       If Not IsEmpty(ay) Then '該儲存格有被公式引用
  56.          For i = 0 To UBound(ay)
  57.            ReDim Preserve Ar(i)
  58.            Ar(i) = ay(i) & r
  59.          Next
  60.         If Application.Count(.Range(Join(Ar, ","))) > 0 Then B.Value = Round(Application.Evaluate("Average(" & Join(Ar, ",") & ")*5/3"), 0)
  61.          Erase Ar
  62.       End If
  63.       End If
  64.     Next
  65. Next
  66. End With
  67. End Sub
複製代碼
學海無涯_不恥下問

TOP

jj369963

帖子
147 
主題
46 
精華
0 
積分
205 
點名
0  
作業系統
windows xp 
軟體版本
office 2003 
閱讀權限
20 
性別
女 
註冊時間
2012-3-19 
最後登錄
2021-5-21 
18#
發表於 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]

TOP

Hsieh

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
19#
發表於 2013-10-8 13:44 | 只看該作者
回復 18# jj369963

不懂你所說
另外 　 套入取代missing 的 R　I　Ａ　S　Ｅ　C是不要*5/3但四捨五入，
                  而CR欄到CW欄 的  R　I　Ａ　S　Ｅ　C　是要乘以5/3
  程式碼執行已經不需要有CR:DC欄位的公式，你驗算看看差異在哪?
  1. Sub Replace_Blank()
  2. Dim A As Range, Ar(), B As Range
  3. Set Upw = CreateObject("Scripting.Dictionary") '帳密
  4. Set dic = CreateObject("Scripting.Dictionary") '參照
  5. fs = ThisWorkbook.Path & "\replace_rule.txt" 'TEXT檔案位置
  6. Close #1 '若已經開啟就先關閉
  7. With Sheets("Sheet0")
  8. Open fs For Input As #1
  9. Do Until EOF(1)
  10.    Line Input #1, mystr
  11.    If InStr(mystr, ",") > 0 Then
  12.    s = InStr(mystr, "(")
  13.    n = InStr(s, mystr, ")")
  14.    mystr = Mid(mystr, s + 1, n - s - 1)
  15.    For Each C In Split(mystr, ",")
  16.      Set A = .Rows(1).Find(C)
  17.      ReDim Preserve Ar(i)
  18.      Ar(i) = Split(A.Address, "$")(1)
  19.      i = i + 1
  20.    Next
  21.    For Each p In Ar
  22.       dic(p) = Ar '記錄公式參照欄位
  23.    Next
  24.    Erase Ar: i = 0
  25.    End If
  26. Loop
  27. Close #1
  28. With Sheets("Sheet1")
  29.   For Each A In .Range(.[A2], .[A2].End(xlDown))
  30.      Upw(CStr(A)) = Array(A.Offset(, 3).Value, A.Offset(, 2).Value) '記錄帳密
  31.   Next
  32. End With
  33. '取代複選位置
  34. Set A = .Range(.[H2], .Cells(.Rows.Count, "CQ").End(xlUp)).Find("*,*")
  35. If Not A Is Nothing Then
  36. Do
  37. ay = Split(A, ",")
  38. For i = 0 To UBound(ay)
  39. ReDim Preserve Ar(i)
  40. Ar(i) = Val(ay(i))
  41. Next
  42.   A.Value = Round(Application.Average(Ar), 0)
  43.   Erase Ar
  44.   Set A = .Range(.[H2], .Cells(.Rows.Count, "CQ").End(xlUp)).Find("*,*", A)
  45. Loop Until A Is Nothing
  46. End If
  47. i = 0
  48. .Select
  49. For Each A In .Range(.[F2], .Cells(.Rows.Count, "F").End(xlUp))
  50.    A.Offset(, -5).Resize(, 2) = Upw(CStr(A)) '填寫帳密
  51.    r = A.Row
  52.    For Each B In .Range(.Cells(r, "H"), .Cells(r, "CQ"))
  53.       If B = "" Then  '找到空格
  54.       ay = dic(Split(B.Address, "$")(1))
  55.       If Not IsEmpty(ay) Then '該儲存格有被公式引用
  56.          For i = 0 To UBound(ay)
  57.            ReDim Preserve Ar(i)
  58.            Ar(i) = ay(i) & r
  59.          Next
  60.         If Application.Count(.Range(Join(Ar, ","))) > 0 Then B.Value = Round(Application.Evaluate("Average(" & Join(Ar, ",") & ")*5/3"), 0)
  61.          Erase Ar
  62.       End If
  63.       End If
  64.     Next
  65. Next
  66. End With
  67. End Sub
複製代碼
學海無涯_不恥下問

TOP

jj369963

帖子
147 
主題
46 
精華
0 
積分
205 
點名
0  
作業系統
windows xp 
軟體版本
office 2003 
閱讀權限
20 
性別
女 
註冊時間
2012-3-19 
最後登錄
2021-5-21 
20#
發表於 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]

TOP

        靜思自在 : 有願放在心裡，沒有身體力行，正如耕田不播種，皆是空過因緣。
123
返回列表 上一主題