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

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

Ｇ２１：
=COUNTIF(INDIRECT("B"&SUBSTITUTE($C$20,"-",":X")),G20)

Ｂ２．格式化條件：
條件１：=(B2=$G$20)*MODE(ROW(),ROW(INDIRECT(SUBSTITUTE($C$20,"-",":"))))　黃底色
條件２∼６，自行去設∼∼
（我的版本只能設３個）
作者: 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

  21. 99: Range("b2:x18").Interior.ColorIndex = 0: Range("G21:L21") = ""
  22. 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

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

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

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

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

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

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

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

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

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



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