返回列表 上一主題 發帖

[發問] replace missing value (求救)

Hsieh

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

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 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
以此類推
學海無涯_不恥下問

TOP

Hsieh

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

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
2#
發表於 2013-9-22 23:38 | 顯示全部帖子
回復 5# jj369963
基本上因為CP:CU欄位的公式參照到F:CO欄位
要在F:CO欄的空格內填入CP:CU所得的值，只能對照後填入數值
不可以利用公式填入空格內，因為這會造成循環參照
利用VBA幫助你填入數值才可達成
  1. Sub ex()
  2. Dim Rng As Range, A As Range, C As Range
  3. r = 2
  4. Do Until Cells(r, 1) = ""
  5.   Set Rng = Cells(r, 6).Resize(, 88)
  6.   If Application.CountA(Rng) < Rng.Count Then
  7.   For Each A In Rng.SpecialCells(xlCellTypeBlanks)
  8.       For Each C In Range(Cells(r, "CP"), Cells(r, "CU"))
  9.           If InStr(C.Formula, A.Address(0, 0)) > 0 Then
  10.              A.Value = Round(C, 0)
  11.           End If
  12.       Next
  13.   Next
  14.   End If
  15. r = r + 1
  16. Loop
  17. End Sub
複製代碼
學海無涯_不恥下問

TOP

Hsieh

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

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
3#
發表於 2013-9-25 17:36 | 顯示全部帖子
回復 8# jj369963

VBA的作用必須CP:CU欄位都有輸入公式
空格才會對應該列的公式參照填入
學海無涯_不恥下問

TOP

Hsieh

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

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
4#
發表於 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

Hsieh

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

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
5#
發表於 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

Hsieh

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

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
6#
發表於 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

Hsieh

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

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
7#
發表於 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

Hsieh

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

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
8#
發表於 2013-10-9 21:37 | 顯示全部帖子
回復 20# jj369963
所以並不需要*5/3嗎?
  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.          If .Range(ay(i) & r) <> "" Then '引用的參照非空白才計入陣列
  58.            ReDim Preserve Ar(j)
  59.            Ar(j) = ay(i) & r
  60.            j = j + 1
  61.          End If
  62.          Next
  63.         If j > 0 Then B.Value = Round(Application.Evaluate("Average(" & Join(Ar, ",") & ")"), 0)
  64.          Erase Ar
  65.          j = 0
  66.       End If
  67.       End If
  68.     Next
  69. Next
  70. End With
  71. End Sub
複製代碼
學海無涯_不恥下問

TOP

Hsieh

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

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
9#
發表於 2013-10-14 09:17 | 顯示全部帖子
回復 25# jj369963
  1. With [H:BC] '1~48題的欄位
  2. .Replace 1, "3@", xlWhole '將1用一個不常用符號取代
  3. .Replace 2, 1, xlWhole '將2用1取代
  4. .Replace 3, 2, xlWhole '將3用2取代
  5. .Replace "3@", 3, xlWhole '將不常用符號用3取代
  6. End With
複製代碼
學海無涯_不恥下問

TOP

Hsieh

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

2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
10#
發表於 2013-10-16 08:38 | 顯示全部帖子
回復 27# jj369963
整個資料全部處理完後，還是有missing(因為無公式可以對應取代)，所以是否可以
   在A-CQ欄 搜尋missing ，並將整列標記顏色(黃色)，舉例如果A15為空值，就將第15列全部標顏色，依此類推

標顏色用格式化條件即可達成
=(COUNTBLANK($A1:$CQ1)>0)*(COUNTA($A1:$CQ1)>0)
學海無涯_不恥下問

TOP

        靜思自在 : 能幹不幹，不如苦幹實幹。
返回列表 上一主題