Sub my_Splitter()
Dim ar_data, ar_300, ar_400, ar_500, ar_600, ar_800, ar_900
Dim myPath As String
Dim myFile As String
Dim i, j, k, m, n, l, q
Dim a, b, c, d, e, f
Application.ScreenUpdating = False
myPath = ThisWorkbook.Path & "\"
Sheet1.Columns("A:F").Copy Destination:=Sheet3.Range("A1")
With Sheet3
.Sort.SortFields.Clear
.Sort.SortFields.Add2 Key:=.Range("C1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange Range("A2:F1117")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
ar_data = Sheet3.Range("A1").CurrentRegion
j = 1: k = 1: m = 1: n = 1: l = 1: q = 1
ReDim ar_300(1 To UBound(ar_data), 1 To 6): ReDim ar_400(1 To UBound(ar_data), 1 To 6)
ReDim ar_500(1 To UBound(ar_data), 1 To 6): ReDim ar_600(1 To UBound(ar_data), 1 To 6)
ReDim ar_800(1 To UBound(ar_data), 1 To 6): ReDim ar_900(1 To UBound(ar_data), 1 To 6)
Sheet3.Range("A1").CurrentRegion.Clear
For i = 2 To UBound(ar_data)
If Val(ar_data(i, 3)) >= 300 And Val(ar_data(i, 3)) <= 399 Then
j = j + 1
For a = 1 To UBound(ar_data, 2)
ar_300(j, a) = ar_data(i, a)
Next
End If
If Val(ar_data(i, 3)) >= 400 And Val(ar_data(i, 3)) <= 499 Then
k = k + 1
For b = 1 To UBound(ar_data, 2)
ar_400(k, b) = ar_data(i, b)
Next
End If
If Val(ar_data(i, 3)) >= 500 And Val(ar_data(i, 3)) <= 599 Then
m = m + 1
For c = 1 To UBound(ar_data, 2)
ar_500(m, c) = ar_data(i, c)
Next
End If
If Val(ar_data(i, 3)) >= 600 And Val(ar_data(i, 3)) <= 699 Then
n = n + 1
For d = 1 To UBound(ar_data, 2)
ar_600(n, d) = ar_data(i, d)
Next
End If
If Val(ar_data(i, 3)) >= 800 And Val(ar_data(i, 3)) <= 999 Then
l = l + 1
For e = 1 To UBound(ar_data, 2)
ar_800(l, e) = ar_data(i, e)
Next
End If
If Val(ar_data(i, 3)) >= 900 And Val(ar_data(i, 3)) <= 999 Then
q = q + 1
For f = 1 To UBound(ar_data, 2)
ar_900(q, f) = ar_data(i, f)
Next
End If
Next
ar_300(1, 1) = Sheet1.Range("A1"): ar_300(1, 2) = Sheet1.Range("B1"): ar_300(1, 3) = Sheet1.Range("C1"): ar_300(1, 4) = Sheet1.Range("D1"): ar_300(1, 5) = Sheet1.Range("E1"): ar_300(1, 6) = Sheet1.Range("F1")
ar_400(1, 1) = Sheet1.Range("A1"): ar_400(1, 2) = Sheet1.Range("B1"): ar_400(1, 3) = Sheet1.Range("C1"): ar_400(1, 4) = Sheet1.Range("D1"): ar_400(1, 5) = Sheet1.Range("E1"): ar_400(1, 6) = Sheet1.Range("F1")
ar_500(1, 1) = Sheet1.Range("A1"): ar_500(1, 2) = Sheet1.Range("B1"): ar_500(1, 3) = Sheet1.Range("C1"): ar_500(1, 4) = Sheet1.Range("D1"): ar_500(1, 5) = Sheet1.Range("E1"): ar_500(1, 6) = Sheet1.Range("F1")
ar_600(1, 1) = Sheet1.Range("A1"): ar_600(1, 2) = Sheet1.Range("B1"): ar_600(1, 3) = Sheet1.Range("C1"): ar_600(1, 4) = Sheet1.Range("D1"): ar_600(1, 5) = Sheet1.Range("E1"): ar_600(1, 6) = Sheet1.Range("F1")
ar_800(1, 1) = Sheet1.Range("A1"): ar_800(1, 2) = Sheet1.Range("B1"): ar_800(1, 3) = Sheet1.Range("C1"): ar_800(1, 4) = Sheet1.Range("D1"): ar_800(1, 5) = Sheet1.Range("E1"): ar_800(1, 6) = Sheet1.Range("F1")
ar_900(1, 1) = Sheet1.Range("A1"): ar_900(1, 2) = Sheet1.Range("B1"): ar_900(1, 3) = Sheet1.Range("C1"): ar_900(1, 4) = Sheet1.Range("D1"): ar_900(1, 5) = Sheet1.Range("E1"): ar_900(1, 6) = Sheet1.Range("F1")
Open myPath & "300_.csv" For Output As #1
For i = 1 To UBound(ar_300)
Print #1, ar_300(i, 1) & "," & ar_300(i, 2); "," & ar_300(i, 3); "," & ar_300(i, 4); "," & ar_300(i, 5); "," & ar_300(i, 6)
Next
Close #1
Open myPath & "400_.csv" For Output As #1
For i = 1 To UBound(ar_400)
Print #1, ar_400(i, 1) & "," & ar_400(i, 2); "," & ar_400(i, 3); "," & ar_400(i, 4); "," & ar_400(i, 5); "," & ar_400(i, 6)
Next
Close #1
Open myPath & "500_.csv" For Output As #1
For i = 1 To UBound(ar_500)
Print #1, ar_500(i, 1) & "," & ar_500(i, 2); "," & ar_500(i, 3); "," & ar_500(i, 4); "," & ar_500(i, 5); "," & ar_500(i, 6)
Next
Close #1
Open myPath & "600_.csv" For Output As #1
For i = 1 To UBound(ar_600)
Print #1, ar_600(i, 1) & "," & ar_600(i, 2); "," & ar_600(i, 3); "," & ar_600(i, 4); "," & ar_600(i, 5); "," & ar_600(i, 6)
Next
Close #1
Open myPath & "800_.csv" For Output As #1
For i = 1 To UBound(ar_800)
Print #1, ar_800(i, 1) & "," & ar_800(i, 2); "," & ar_800(i, 3); "," & ar_800(i, 4); "," & ar_800(i, 5); "," & ar_800(i, 6)
Next
Close #1
Open myPath & "900_.csv" For Output As #1
For i = 1 To UBound(ar_900)
Print #1, ar_900(i, 1) & "," & ar_900(i, 2); "," & ar_900(i, 3); "," & ar_900(i, 4); "," & ar_900(i, 5); "," & ar_900(i, 6)
Next
Close #1
Application.ScreenUpdating = True
MsgBox "完成"
End Sub
uj5u.com熱心網友回復：
.Sort.SortFields.Add2 Key:=.Range("C1"), _SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
2的原因？
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/18479.html
標籤：VBA