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