Board logo

標題: 區域內顯示輸入值填滿顏色之問題 [打印本頁]

作者: s7659109    時間: 2015-11-13 09:52     標題: 區域內顯示輸入值填滿顏色之問題

問題1:全部(列2-列18),當輸入順序1-順序6(不重複)後,上述區域相同之值以儲存格填滿黃色顯示,並在個數統計欄,在各順序下方統計出個數。

問題2:限制區間(例如:列10-列18),當輸入順序1-順序6(不重複)後,上述區域相同之值以儲存格填滿黃色顯示,並在個數統計欄,在各順序下方統計出個數。
作者: hcm19522    時間: 2015-11-13 12:55

http://blog.xuite.net/hcm19522/twblog/356570552
作者: s7659109    時間: 2015-11-13 13:43

附檔有修正,我的問題雖然有二,但輸入資料只有一列
,當輸入列範圍不同時,才會更動,並按不同顏色顯示。

問題1:全部(列2-列18),當輸入搜尋範圍(2-18),表示搜尋b2至x18,並填入順序1-順序6(不重複)後,上述區域相同之值以儲存格填滿各順序之顏色顯示,並在個數統計欄,在各順序下方統計出個數。

問題2:全部(列10-列18),當輸入搜尋範圍(10-18),表示搜尋b10至x18,並填入順序1-順序6(不重複)後,上述區域相同之值以儲存格填滿各順序之顏色顯示,並在個數統計欄,在各順序下方統計出個數。
作者: owen06    時間: 2015-11-13 13:59

回復 1# s7659109


    這樣有符合你的需求嗎?
  1. Sub check_it()
  2. Sheets("工作表1").Range("B2:x18").Interior.ColorIndex = 0
  3. Sheets("工作表1").Range("g21:l21").Clear
  4. For i = 7 To 12
  5.     For Each mrng In Sheets("工作表1").Range("B2:x18")
  6.      If mrng.Value = Cells(20, i) Then
  7.       mrng.Interior.ColorIndex = 6
  8.       Cells(20, i).Offset(1, 0) = Cells(20, i).Offset(1, 0).Value + 1
  9.      End If
  10.     Next
  11. Next
  12. End Sub

  13. Sub check_it2()
  14. Sheets("工作表1").Range("B2:x18").Interior.ColorIndex = 0
  15. Sheets("工作表1").Range("G23:L23").Clear
  16. RngA = Left([c22], Application.Find("-", [c22]) - 1)
  17. RngB = Right([c22], Len([c22]) - (Application.Find("-", [c22])))
  18. For x = 7 To 12
  19.     For Each mrng In Sheets("工作表1").Range("B" & RngA & ":x" & RngB)
  20.      If mrng.Value = Cells(22, x) Then
  21.       mrng.Interior.ColorIndex = 6
  22.       Cells(22, x).Offset(1, 0) = Cells(22, x).Offset(1, 0).Value + 1
  23.      End If
  24.     Next
  25. Next
  26. End Sub
複製代碼

作者: s7659109    時間: 2015-11-13 14:15

套用程式碼,仍有誤,問題已修正如下
問題1:全部(列2-列18),當輸入搜尋範圍(2-18),表示搜尋b2至x18,並填入順序1-順序6(不重複)後,上述區域相同之值以儲存格填滿各順序之顏色顯示,並在個數統計欄,在各順序下方統計出個數。

問題2:全部(列10-列18),當輸入搜尋範圍(10-18),表示搜尋b10至x18,並填入順序1-順序6(不重複)後,上述區域相同之值以儲存格填滿各順序之顏色顯示,並在個數統計欄,在各順序下方統計出個數。
作者: owen06    時間: 2015-11-13 14:29

回復 6# s7659109


    這樣子呢?
  1. Sub check_it()
  2. Range("B2:x18").Interior.ColorIndex = 0
  3. Range("G21:L21").Clear
  4. RngA = Left([c20], Application.Find("-", [c20]) - 1)
  5. RngB = Right([c20], Len([c20]) - (Application.Find("-", [c20])))
  6. For x = 7 To 12
  7.     For Each mrng In Sheets("工作表1").Range("B" & RngA & ":x" & RngB)
  8.      If mrng.Value = Cells(20, x) Then
  9.       mrng.Interior.ColorIndex = 6
  10.       Cells(20, x).Offset(1, 0) = Cells(20, x).Offset(1, 0).Value + 1
  11.      End If
  12.     Next
  13.   If Cells(21, x) = "" Then Cells(21, x).Value = 0
  14. Next
  15. End Sub
複製代碼

作者: 准提部林    時間: 2015-11-13 14:48

G21:
=COUNTIF(INDIRECT("B"&SUBSTITUTE($C$20,"-",":X")),G20)

B2.格式化條件:
條件1:=(B2=$G$20)*MODE(ROW(),ROW(INDIRECT(SUBSTITUTE($C$20,"-",":")))) 黃底色
條件2∼6,自行去設∼∼
(我的版本只能設3個)
作者: s7659109    時間: 2015-11-13 15:28

程式碼部分,是可以,但只顯示黃色,可否按順序1~6分成不同顏色顯示,另外每修改1次
都要到程式碼中,重新執行1次,才能更新,是否還有其他方式,更改時,就可直接更動。
(儲存為.xlsm)
作者: owen06    時間: 2015-11-13 17:17

本帖最後由 owen06 於 2015-11-13 17:23 編輯

回復 9# s7659109

像這樣?
另外你的b2:x18似乎因為儲存格有設定格式化條件的關係,所以有些資料跑出來的顏色會錯亂,把格式化條件清掉才會正常
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. With Target
  3.    If .Row = 20 And .Column >= 7 And .Column <= 12 Then
  4.     RngA = Left([C20], Application.Find("-", [C20]) - 1)
  5.     RngB = Right([C20], Len([C20]) - (Application.Find("-", [C20])))
  6.     Ans = .Value
  7. On Error GoTo 99
  8.    If Application.CountA([G20:L20]) = 0 Then GoTo 99
  9.    If .Value = "" Then .Offset(1, 0) = ""
  10.    
  11.      For Each Mrng In Range("B" & RngA & ":x" & RngB)
  12.        If Mrng.Value = Ans Then
  13.         Mrng.Interior.ColorIndex = .Offset(-1, 0).Interior.ColorIndex
  14.         .Offset(1, 0) = .Offset(1, 0).Value + 1
  15.        End If
  16.      Next
  17.    End If
  18. End With
  19. Exit Sub

  20. 99: Range("b2:x18").Interior.ColorIndex = 0: Range("G21:L21") = ""
  21. End Sub
複製代碼

作者: hcm19522    時間: 2015-11-13 19:25

拜讀 "准大" ,G20:L20不重複且防止整列相同
G20:L20{=INDIRECT(TEXT(RIGHT(MIN(IF(COUNTIF($F20:F20,INDIRECT("B"&SUBSTITUTE($C$20,"-",":X")))=0, COLUMN(INDIRECT("B"&SUBSTITUTE($C$20,"-",":X")))+ROW(INDIRECT("B"&SUBSTITUTE($C$20,"-",":X")))*100)),4),"!R0C00"),)
作者: hcm19522    時間: 2015-11-13 21:09

http://blog.xuite.net/hcm19522/twblog/356624511
G21:L21與格式化 以 "准大" 精簡
作者: 准提部林    時間: 2015-11-13 21:17

Sub 執行()
Dim xR As Range, MH, Brr
[B2:X18].Interior.ColorIndex = 0
[G21:L21].ClearContents
Brr = [G21:L21]
For Each xR In Range("B" & Replace([C20], "-", ":X"))
  MH = Application.Match(xR, [G20:L20], 0)
  If IsNumeric(MH) Then
    xR.Interior.ColorIndex = [G19].Cells(1, MH).Interior.ColorIndex
    Brr(1, MH) = Brr(1, MH) + 1
  End If
Next
[G21:L21] = Brr
End Sub
作者: s7659109    時間: 2015-11-17 10:05

准大:
套用程式碼後,發現部分顏色對照有誤。
另每次有修改,需跳到程式碼頁面重新執行1次,
若要在工作底稿中加入快速鈕,是否可行?
作者: yen956    時間: 2015-11-18 11:40

試試看:
  1. Sub 開始統計()
  2.     Dim Cel As Range, Rng As Range
  3.     Dim FstAddr As String, ndx As Integer, cNum As Integer
  4.     Set Rng = Range("B" & [B21] & ":X" & [C21] & "")
  5.     cNum = 0
  6.     For Each Cel In [G20:L20]
  7.         cNum = Cel.Offset(-1, 0).Interior.ColorIndex
  8.         Cel.Interior.ColorIndex = cNum
  9.         ndx = 0
  10.         On Error GoTo next1
  11.         Rng.Find(What:=Cel, LookIn:=xlFormulas, LookAt:=xlWhole).Activate
  12.         FstAddr = ActiveCell.Address
  13.         Cel.Interior.ColorIndex = cNum
  14.         ActiveCell.Interior.ColorIndex = cNum
  15.         Do
  16.             ndx = ndx + 1
  17.             On Error GoTo next1
  18.             Rng.FindNext(After:=ActiveCell).Activate
  19.             ActiveCell.Interior.ColorIndex = cNum
  20.         Loop Until FstAddr = ActiveCell.Address
  21. next1:
  22.         Cel.Offset(1, 0) = ndx
  23.     Next
  24. End Sub

  25. Private Sub Worksheet_Change(ByVal Target As Range)
  26.     Dim Rng As Range
  27.     Set Rng = Application.Union([B21:C21], [G20:L20])
  28.     If Intersect(Target, Rng) Is Nothing Then Exit Sub
  29.     If Not Intersect(Target, [B21:C21]) Is Nothing Then
  30.         [B2:X18].Interior.ColorIndex = xlNone
  31.         [G20:L20].Interior.ColorIndex = xlNone
  32.         [G21:L21] = ""
  33.         If [B21] > [C21] Then
  34.             MsgBox "注意:" & Chr(10) & "啟始列的值 不可以大於 終止列的值", vbCritical
  35.             Exit Sub
  36.         End If
  37.     End If
  38.     If Not Intersect(Target, [G20:L20]) Is Nothing Then
  39.         [B2:X18].Interior.ColorIndex = xlNone
  40.         [G20:L20].Interior.ColorIndex = xlNone
  41.         [G21:L21] = ""
  42.         [N21] = "= COUNTA(G20:L20)"
  43.         If [N21] <> 6 Then Exit Sub
  44.         [N20] = "=SUMPRODUCT((G20:L20<>"""")/COUNTIF(G20:L20,G20:L20&""""))"
  45.         If [N20] < 6 Then
  46.             MsgBox "注意:" & Chr(10) & "輸入區資料重覆!!", vbCritical
  47.             Exit Sub
  48.         End If
  49.     End If
  50.     開始統計
  51. End Sub
複製代碼
[attach]22478[/attach]
作者: s7659109    時間: 2015-11-18 14:04

進階問題:       
        1.當輸入區如輸入e100程式會出現錯誤,可否出現視窗方式表現?
        2.目前列輸入至18列,程式可否控制,當再輸入完列19時,自動再空出1列,原20列自動向下調整1列,以此類推!
        3.為何輸入區與順序列顏色會不一致。
作者: yen956    時間: 2015-11-18 15:25

回復 15# s7659109
以#14F 為例回覆:
Q1. 在倒數第4列
(即在49與50列之間)
插入
        On Error Resume Next
        [B2:X18].Find(What:=Target, LookIn:=xlFormulas, LookAt:=xlWhole).Activate
        MsgBox "注意:" & Chr(10) & "資料輸入錯誤!!", vbCritical
        Exit Sub
即可.
Q2. 這是版面設計問題,
何不將輸入區直放到到最下面?
中間列空白列可暫先穏藏?
Q3. 看不出輸入區與順序列顏色有何不一致?
不是有動畫圖可對照嗎?
作者: yen956    時間: 2015-11-18 15:45

回復 15# s7659109
Sorry, Q1 還沒有找到答案, 原想法會進入自我循環, Sorry!!
作者: s7659109    時間: 2015-11-18 15:46

問題3:有附檔(工作表1)順2、3、4確實不一致(office2010)會有差嗎?
問題2:倘列19、20放到最前面,後面陸續增加,原程式碼是否函括在內,而可行?
作者: yen956    時間: 2015-11-18 19:00

回復 18# s7659109
問題2:沒錯, 只要在VBA中相關位址改一改就行了, 而且你的想法(放到最上面)更棒!!
問題3:不是2010的問題, 而是, 因為資料輸入錯誤(也就是前面的Q1問題),
我也不知道要如何改,
目前想到的是改用 CommandButton(被動執行),
不要用 Worksheet_Change(自動執行)才不會掉進自我循環中,
另請高明吧, Sorry!!
作者: yen956    時間: 2015-11-18 20:05

回復 13# s7659109
試試看:
我試過好像沒問題
還是舊的檔, 問題40-標示-1.rar, 但b21,c21 有改
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng As Range, Cel As Range
    Set Rng = Application.Union([B21:C21], [G20:L20])
    If Intersect(Target, Rng) Is Nothing Then Exit Sub
    If Not Intersect(Target, [B21:C21]) Is Nothing Then
        [B2:X18].Interior.ColorIndex = xlNone
        [G20:L20].Interior.ColorIndex = xlNone
        [G21:L21] = ""
        If [B21] > [C21] Then
            MsgBox "注意:" & Chr(10) & "啟始列的值 不可以大於 終止列的值", vbCritical
            Exit Sub
        End If
    End If
    Set Rng = Range("B" & [B21] & ":X" & [C21] & "")
    If Not Intersect(Target, [G20:L20]) Is Nothing Then
        [B2:X18].Interior.ColorIndex = xlNone
        [G20:L20].Interior.ColorIndex = xlNone
        [G21:L21] = ""
        On Error Resume Next
        Set Cel = Rng.Find(What:=Target, LookIn:=xlFormulas, LookAt:=xlWhole)
        If Cel Is Nothing Then
            MsgBox "注意:" & Chr(10) & "資料輸入錯誤!!", vbCritical
            Exit Sub
        End If
        [N21] = "= COUNTA(G20:L20)"
        If [N21] <> 6 Then Exit Sub
        [N20] = "=SUMPRODUCT((G20:L20<>"""")/COUNTIF(G20:L20,G20:L20&""""))"
        If [N20] < 6 Then
            MsgBox "注意:" & Chr(10) & "輸入區資料重覆!!", vbCritical
            Exit Sub
        End If
    End If
    開始統計
End Sub
作者: s7659109    時間: 2015-11-19 07:53

程式碼貼上,出現下述畫面!
作者: yen956    時間: 2015-11-19 14:11

試試看(完整版):
  1. Option Explicit
  2. Sub 開始統計()
  3.     Dim Cel As Range, Rng As Range
  4.     Dim FstAddr As String
  5.     Dim ndx As Integer, i As Integer, cNum As Integer
  6.     Set Rng = Range("B" & [B3] & ":X" & [C3] & "")   '設定啟始列與終止列之間的 小搜尋範圍
  7.     '先搜尋大範圍
  8.     For Each Cel In [G2:L2]
  9.         On Error Resume Next         '忽略錯誤繼續執行 VBA 代碼, 避免出現錯誤消息
  10.         Set Cel = [B5:X21].Find(What:=Cel, LookIn:=xlFormulas, LookAt:=xlWhole)   '設定[B5:X21]為搜尋範圍
  11.         If Cel Is Nothing Then
  12.             MsgBox "注意:" & Chr(10) & "資料輸入錯誤!!", vbCritical
  13.             Exit Sub
  14.         End If
  15.     Next
  16.     '再搜尋小範圍
  17.     Set Rng = Range("B" & [B3] & ":X" & [C3] & "")   '設定啟始列與終止列之為搜尋範圍
  18.     Rng.Select
  19.     For i = 7 To 10
  20.         With Selection.Borders(i)
  21.             .LineStyle = xlContinuous
  22.             .Weight = xlMedium
  23.         End With
  24.     Next
  25.     For Each Cel In [G2:L2]
  26.         Cel.Activate
  27.         cNum = Cel.Offset(-1, 0).Interior.ColorIndex
  28.         Cel.Interior.ColorIndex = cNum
  29.         ndx = 0
  30.         On Error Resume Next         '忽略錯誤繼續執行 VBA 代碼, 避免出現錯誤消息
  31.         Rng.Find(What:=Cel, LookIn:=xlFormulas, LookAt:=xlWhole).Activate
  32.         If ActiveCell.Address = Cel.Address Then GoTo next1   '如果原地踏就是找不到
  33.         '如果有找到, ... ...
  34.         ActiveCell.Interior.ColorIndex = cNum
  35.         FstAddr = ActiveCell.Address
  36.         Do
  37.             ndx = ndx + 1
  38.             Rng.FindNext(After:=ActiveCell).Activate    '繼續找下一個
  39.             ActiveCell.Interior.ColorIndex = cNum
  40.         Loop Until FstAddr = ActiveCell.Address         '直到回到第一次找到的儲存格
  41. next1:
  42.         Cel.Offset(1, 0) = ndx    '統計值寫入 ndx, 換下一格
  43.     Next
  44. End Sub

  45. Sub 清除底色_格線及統計結果()
  46.     Dim i As Integer
  47.     [B5:X21].Select
  48.     For i = 3 To 4
  49.         Selection.Borders(i).LineStyle = xlNone
  50.     Next
  51.     For i = 7 To 10
  52.         Selection.Borders(i).LineStyle = xlNone
  53.     Next
  54.     Selection.Interior.ColorIndex = xlNone
  55.     [G3:L3] = ""
  56. End Sub

  57. Private Sub Worksheet_Change(ByVal Target As Range)    'Target就是獨動 Worksheet_Change 的Range
  58.     Dim Rng As Range, Cel As Range
  59.     Set Rng = Application.Union([B3:C3], [G2:L2])   '設定 判斷條件 及輸入區 為獨動 Worksheet_Change 的範圍
  60.     If Intersect(Target, Rng) Is Nothing Then Exit Sub   '如果不在獨動範圍, 離開
  61.     If Target.Count > 1 Then Exit Sub       '一次改變太多格, 離開
  62.     清除底色_格線及統計結果
  63.     If Not Intersect(Target, [B3:C3]) Is Nothing Then   '如果獨動範圍為 判斷條件區
  64.         If [B3] > [C3] Then      '如果 啟始列的值 大於 終止列的值
  65.             MsgBox "注意:" & Chr(10) & "啟始列的值 不可以大於 終止列的值!!", vbCritical
  66.             Exit Sub
  67.         End If
  68.     End If
  69.     If WorksheetFunction.CountA([G2:L2]) < 6 Then Exit Sub    '如果輸入區未滿6格, 離開
  70.     [N2] = "=SUMPRODUCT((G2:L2<>"""")/COUNTIF(G2:L2,G2:L2&""""))"   '計算[G2:L2]的不重覆格有幾格
  71.     If [N2] < 6 Then        '如果不重覆格不到6格(注意輸入區已滿6格), 警告並離開
  72.         MsgBox "注意:" & Chr(10) & "輸入區資料重覆!!", vbCritical
  73.         Exit Sub
  74.     End If
  75.     開始統計
  76. End Sub
複製代碼
[attach]22498[/attach]
[attach]22499[/attach]
作者: s7659109    時間: 2015-11-19 15:44

謝謝,還滿完整,但最後一個請求:
1.倘列數再增加(如再增100列,甚至1000列,甚至列自動增加時,搜尋列數自動跟著增加,並建議表單選項拿掉,因列數大長時,實在不好用)如何調整。
2.搜尋區域增加為2區
作者: yen956    時間: 2015-11-19 17:12

回復 23# s7659109
Sorry, 太難了!!
作者: s7659109    時間: 2015-11-20 07:58

謝謝yen956努力到此,但還是希望有人幫忙最後提出的問題!
作者: yen956    時間: 2015-11-23 18:09

回復 25# s7659109
(這一兩天老是回錯主題, 連貼兩次都貼錯地方, 真奇怪!),
經准大再三指正後, 總算完成了!!
試試看:
  1. Option Explicit
  2. Public inAllNum As Integer
  3. Public inNowNum As Integer

  4. Function BigRng() As Range
  5.     Dim rL As String, I As Integer
  6.     rL = Split([B5].End(xlToRight).Address, "$")(1)
  7.     Set BigRng = Range("B5:" & rL & [B5].End(xlDown).Row & "")
  8.     BigRng.Select
  9.     Selection.Interior.ColorIndex = xlNone    '清除底色
  10.     For I = 1 To 4
  11.         Selection.Borders(I).LineStyle = xlNone   '清除格線
  12.     Next
  13. '    For I = 7 To 10
  14. '        Selection.Borders(I).LineStyle = xlNone
  15. '    Next
  16. End Function

  17. Function SmallRng() As Range
  18.     Dim rL As String, I As Integer
  19.     rL = Split([B5].End(xlToRight).Address, "$")(1)
  20.     Set SmallRng = Range("B" & [D2] & ":" & rL & [D3] & "")    '設定啟始列與終止列之為搜尋範圍
  21. End Function

  22. Function inputRng() As Range
  23.     Dim rL As String, cNumAr
  24.     Dim str1 As String, I As Integer
  25.     cNumAr = Array(4, 6, 7, 8, 15, 17, 19, 20, 22, 24, 33, 35, 36, 37, 39, 40)  '挑選淺色系
  26.     Rows("1:3").Interior.ColorIndex = xlNone     '清除輸入區底色
  27.     rL = Split([G1].End(xlToRight).Address, "$")(1)
  28.     Range("G3:" & rL & "3") = ""    '清除統計結果
  29.     inAllNum = [G1].End(xlToRight).Column - 6    '輸入區共有幾格
  30.     inNowNum = [G2].End(xlToRight).Column - 6    '目前已經輸入幾格
  31.     [F1].FormulaR1C1 = "=SUMPRODUCT((R[1]C[1]:R[1]C[" & inAllNum & "]<>"""")/COUNTIF(R[1]C[1]:R[1]C[" & inAllNum & "],R[1]C[1]:R[1]C[" & inAllNum & "]&""""))"
  32.     For I = 7 To 6 + inAllNum
  33.         Cells(1, I).Resize(3).Interior.ColorIndex = cNumAr(I - 7)
  34.     Next
  35.     str1 = "G2:" & rL & "2"
  36.     Set inputRng = Range(str1)
  37. End Function

  38. Sub 開始統計()
  39.     Dim inRng As Range, bRng As Range, sRng As Range
  40.     Dim Rng As Range, Cel As Range
  41.     Dim FstAddr As String
  42.     Dim ndx As Integer, cNum As Integer
  43.     Set bRng = BigRng
  44.     Set sRng = SmallRng
  45.     Set inRng = inputRng
  46.    
  47.     '先搜尋大範圍
  48.     For Each Cel In inRng
  49.         If Cel = "" Then Exit For
  50.         On Error Resume Next         '忽略錯誤繼續執行 VBA 代碼, 避免出現錯誤消息
  51.         Set Cel = bRng.Find(What:=Cel, LookAt:=xlWhole)   '在大範圍中搜尋
  52.         If Cel Is Nothing Then
  53.             MsgBox "注意:" & Chr(10) & "資料輸入錯誤!!" & Chr(10) & "請修正!!", vbCritical
  54.             Exit Sub
  55.         End If
  56.     Next
  57.     '再搜尋小範圍
  58.     For Each Cel In inRng
  59.         Cel.Activate
  60.         cNum = Cel.Interior.ColorIndex
  61.         ndx = 0
  62.         On Error Resume Next         '忽略錯誤繼續執行 VBA 代碼, 避免出現錯誤消息
  63.         sRng.Find(What:=Cel, LookAt:=xlWhole).Activate
  64.         If ActiveCell.Address = Cel.Address Then GoTo next1   '如果原地踏就是找不到
  65.         '如果有找到, ... ...
  66.         ActiveCell.Interior.ColorIndex = cNum
  67.         FstAddr = ActiveCell.Address
  68.         Do
  69.             ndx = ndx + 1
  70.             sRng.FindNext(After:=ActiveCell).Activate   '繼續找下一個
  71.             ActiveCell.Interior.ColorIndex = cNum
  72.         Loop Until FstAddr = ActiveCell.Address         '直到回到第一次找到的儲存格
  73. next1:
  74.         Cel.Offset(1, 0) = ndx    '統計值寫入 ndx, 換下一格
  75.     Next
  76. End Sub
  77. Private Sub CommandButton1_Click()
  78.     Dim Rng As Range, inRng As Range, bRng As Range, sRng As Range
  79.     Dim I As Integer
  80.     Set bRng = BigRng
  81.     Set sRng = SmallRng
  82.     Set inRng = inputRng
  83.    
  84.     If Val([D2]) < 5 Then
  85.         MsgBox "注意:" & Chr(10) & "判斷條件的啟始列的值 不可小於 5!!", vbCritical
  86.         Exit Sub
  87.     End If
  88.     If Val([D3]) > [B5].End(xlDown).Row Then
  89.         MsgBox "注意:" & Chr(10) & "判斷條件的終止列的值 不可大於" & [B5].End(xlDown).Row & "!!", vbCritical
  90.         Exit Sub
  91.     End If
  92.     If Val([D2]) > Val([D3]) Then      '如果 啟始列的值 大於 終止列的值
  93.         MsgBox "注意:" & Chr(10) & "啟始列的值 不可以大於 終止列的值!!", vbCritical
  94.         Exit Sub
  95.     End If
  96.     If inNowNum < inAllNum Then
  97.         MsgBox "注意:" & Chr(10) & "輸入區尚未填满前," & Chr(10) & "請勿按【開始統計】!!", vbCritical
  98.         Exit Sub     '如果輸入區未滿格, 離開
  99.     End If
  100.     If Val([F1]) < inNowNum Then
  101.         MsgBox "注意:" & Chr(10) & "輸入區的值重覆," & Chr(10) & "請修正!!", vbCritical
  102.         Exit Sub
  103.     End If
  104.     開始統計
  105.     SmallRng.Select
  106.     For I = 7 To 10
  107.         With Selection.Borders(I)      '畫格線
  108.             .LineStyle = xlContinuous
  109.             .Weight = xlMedium
  110.         End With
  111.     Next
  112. End Sub
複製代碼
  
[attach]22571[/attach]
作者: yen956    時間: 2015-11-23 18:25

[attach]22572[/attach]
作者: s7659109    時間: 2015-11-26 11:17

又有進階問題請教,分為輸入區與顯示區,其他功能
好用請保持。




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