Sắp xếp tiếng việt phần II
Nội dung code của form SortVN như sau:
Public Vchon As Range
Dim Cot As Integer, Dong As Integer, Socot As Integer, Sodong As Integer
Private Sub CBsort_Click()
Dim x, y: Dim khoatp(2), vchontam As Range
Dim tmp1(2) As Integer, cotxep(2), i, j As Integer
Dim thu(2) As String, khoa(2) As String
cotxep(1) = ComboBox1.ListIndex
cotxep(2) = ComboBox2.ListIndex
x = IIf(OptionButton1.Value, xlAscending, xlDescending)
y = IIf(OptionButton3.Value, xlAscending, xlDescending)
If Trim(ComboBox1.Text) = "(Khong)" Then
MsgBox "Ban phai chon cot can sap xep !", vbOKOnly + vbCritical, "Thong bao !"
Exit Sub
End If
thu(1) = ComboBox1.Text
thu(2) = ComboBox2.Text
'============================================================
For i = 1 To 2
If cotxep(i) >= 1 Then
Set khoatp(i) = Range(Cells(Dong, Cot + Socot + i - 2), Cells(Sodong + Dong - 1, Cot + Socot + i - 2))
khoatp(i).Copy
khoatp(i).Insert shift:=xlToRight
khoatp(i).Clear
tmp1(i) = Cot + Socot + i - 1
khoa(i) = Laycell(Dong, tmp1(i))
Set khoatp(0) = Range(Cells(Dong, Cot + Socot), Cells(Sodong + Dong - 1, tmp1(i)))
ActiveSheet.Columns(tmp1(i)).EntireColumn.Hidden = True
End If
Next i
For i = 1 To 2
If cotxep(i) > 0 Then
For j = Dong To Dong + Sodong - 1
ActiveSheet.Cells(j, tmp1(i)).Value = "=Machuv( " + Laycotsx(thu(i), j) + ")"
Next j
Set vchontam = Range(Cells(Dong, Cot), Cells(Dong + Sodong - 1, tmp1(i)))
End If
Next i
'=====================
If cotxep(2) <> 0 Then
vchontam.Sort Key1:=Range(khoa(1)), Order1:=x, Key2:=Range(khoa(2)), Type:=xlSortValues, Order2:=y, Header:=xlNo, OrderCustom:=1, MatchCase:=False, SortMethod:=2
khoatp(0).Delete
Else
vchontam.Sort Key1:=ActiveSheet.Range(khoa(1)), Order1:=x, Header:=xlNo, OrderCustom:=1, MatchCase:=False, SortMethod:=2
khoatp(0).Delete
End If
For i = 1 To 2
If cotxep(i) >= 1 Then
ActiveSheet.Columns(tmp1(i)).EntireColumn.Hidden = False
End If
Next i
End
End Sub
Private Sub CommandButton1_Click()
End
End Sub
Private Sub UserForm_Initialize()
If InStr(1, ActiveCell.Characters(Start:=1, Length:=1).Font.Name, "Vni", 1) <> 0 Then
Luachon = 1
Else
If Left(ActiveCell.Characters(Start:=1, Length:=1).Font.Name, 1) = "." Then
Luachon = 2
Else
Luachon = 3
End If
End If
Set Vchon = Application.Selection
Dong = Vchon.Rows(1).Row
Cot = Vchon.Columns(1).Column
Socot = Vchon.Columns.Count
Sodong = Vchon.Rows.Count
'=====================================
OptionButton1.GroupName = "button"
OptionButton2.GroupName = "button"
OptionButton3.GroupName = "cbut"
OptionButton4.GroupName = "cbut"
OptionButton3.Value = True
'=======================================
Luachoncot True
End Sub
Function DatSapXep(obj As Object, Mdinh As Integer)
Dim i As Integer, j As Integer
Dim lay As String
With obj
.Clear
.AddItem "(Khong)"
For i = 0 To Socot - 1
lay = Cells(Dong, Cot + i).Address(ReferenceStyle:=xlA1)
lay = Right(lay, Len(lay) - 1)
j = InStr(1, lay, "$") - 1
.AddItem "Theo cot : " + Left(lay, j)
Next i
.ListIndex = Mdinh
End With
End Function
Private Sub Luachoncot(Xet As Boolean)
With Me
DatSapXep .ComboBox1, 1
DatSapXep .ComboBox2, 0
End With
End Sub
Function Laycotsx(obj As String, Mdinh As Integer) As String
Dim i, j As Integer
Dim lay As String
j = InStr(1, obj, ":") + 1
lay = Trim(Right(obj, Len(obj) - j))
Laycotsx = lay & Trim(Str(Mdinh))
End Function
Private Function Laycell(dongcell As Integer, cotcell As Integer) As String
Dim j As Integer
Dim lay As String
lay = Cells(dongcell, cotcell).Address(ReferenceStyle:=xlA1)
lay = Right(lay, Len(lay) - 1)
j = InStr(1, lay, "$") - 1
Laycell = Left(lay, j) & Trim(Str(dongcell))
End Function
Rất tiếc là tôi không thể đưa hình ảnh lên cho các bạn tham khảo được.
Thế là các bạn tha hồ tham khảo. Nó có nhiều điều để chúng ta học hỏi.
Lại...Lại chúc các bạn thành công.
Tôi lại phải đi TQ rồi !!! Sắp sửa bị nghỉ việc...
Chúc các bạn một năm mới vui vẻ.
Lê Văn Duyệt.
levanduyet@yahoo.com
pen()
