- 帖子
- 1517
- 主題
- 40
- 精華
- 0
- 積分
- 1541
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-10-31
|
18#
發表於 2022-7-25 13:52
| 只看該作者
回復 17# 074063
謝謝前輩提出各種需求!後學藉此習得多種技巧!謝謝!
今日習得 文字可以比大小,其規則如排序!
清單可排序的方式修改如下:
Sub TEST_4()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableCancelKey = xlDisabled
Application.EnableEvents = False
Dim Vrr, C1V, C2V, i&, Spc1rr, Spc2rr, x&
With Sheets("data")
Vrr = .Range(.[A2], .Cells(.Cells(.Rows.Count, "B").End(xlUp).Row, "B"))
End With
C1V = [data!A2] & ","
C2V = [data!B2] & ","
For i = 1 To UBound(Vrr)
If InStr(C1V, Vrr(i, 1) & ",") = 0 Then
Spc1rr = Split(C1V, ",")
For x = 0 To UBound(Spc1rr)
If Vrr(i, 1) < Spc1rr(x) Then '
Spc1rr(x) = Vrr(i, 1) & "," & Spc1rr(x)
C1V = Join(Spc1rr, ",")
Exit For
ElseIf Vrr(i, 1) > Spc1rr(x) And Vrr(i, 1) < Spc1rr(x + 1) Then
Spc1rr(x) = Spc1rr(x) & "," & Vrr(i, 1)
C1V = Join(Spc1rr, ",")
Exit For
ElseIf Spc1rr(x + 1) = "" Then
Spc1rr(x) = Vrr(i, 1)
C1V = Join(Spc1rr, ",")
Exit For
End If
Next
End If
If InStr(C2V, Vrr(i, 2) & ",") = 0 Then
Spc2rr = Split(C2V, ",")
For x = 0 To UBound(Spc2rr)
If Vrr(i, 2) < Spc2rr(x) Then '
Spc2rr(x) = Vrr(i, 2) & "," & Spc2rr(x)
C2V = Join(Spc2rr, ",")
Exit For
ElseIf Vrr(i, 2) > Spc2rr(x) And Vrr(i, 2) < Spc2rr(x + 1) Then
Spc2rr(x) = Spc2rr(x) & "," & Vrr(i, 2)
C2V = Join(Spc2rr, ",")
Exit For
ElseIf Spc2rr(x + 1) = "" Then
Spc2rr(x) = Vrr(i, 2)
C2V = Join(Spc2rr, ",")
Exit For
End If
Next
End If
Next
If [list!I1] = "大至小排序" Then
Spc1rr = Split(C1V, ",")
C1V = ""
For i = UBound(Spc1rr) - 1 To 0 Step -1
C1V = C1V & "," & Spc1rr(i)
Next
Spc2rr = Split(C2V, ",")
C2V = ""
For i = UBound(Spc2rr) - 1 To 0 Step -1
C2V = C2V & "," & Spc2rr(i)
Next
End If
C1V = "全部機台," & C1V
With Sheets("chart").[C1].Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=C1V
End With
With Sheets("chart").[C2].Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=C2V
End With
Application.EnableEvents = True
Set Vrr = Nothing
Set Spc1rr = Nothing
Set Spc2rr = Nothing
End Sub
持續學習中! 請各位前輩不吝指正! 謝謝! |
|
