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
