TrungChinhs
Thành viên tích cực
- Tham gia
- 18/2/08
- Bài viết
- 1,475
- Được thích
- 2,469
- Nghề nghiệp
- Công chức
Tôi vẫn biết rằng muốn học VBA tốt thì trước hết phải biết tiếng Anh. Nhưng tôi vẫn muốn nhờ các bạn GPE giúp đỡ những người không biết tiếng Anh (như Tôi chẳng hạn) tiếp cận với VBA bằng cách Dịch code ra tiếng Việt như ví dụ sau:
Nhờ các bạn dịch giúp ra tiếng Việt đoạn code trong file đính kèm:
Nhờ các bạn dịch giúp ra tiếng Việt đoạn code trong file đính kèm:
[FONT="]Xin cảm ơn![/FONT]
PHP:
Option Explicit
Sub TongHop()
Dim Sh As Worksheet
Dim Rng As Range, Clls As Range, SRng As Range, bRng As Range
Dim Tong As Single
Dim bJ As Byte, DgCuoi As Long, Lrow As Long
Application.ScreenUpdating = False
Sheets("Tong Hop").[it1] = "ChuHo"
1 ' Them Cac Dong Phu Tro Vo Cac Sheet:'
For Each Sh In Worksheets
If Sh.Name <> "Tong hop" Then
Sh.Select: Lrow = [a65500].End(xlUp).Row
Range("B2:B" & Lrow).Copy Destination:=Sheets("Tong hop").Range("IT" & _
Sheets("Tong Hop").[it65500].End(xlUp).Row + 1)
Columns("A:A").Select
Selection.SpecialCells(xlCellTypeConstants, 1).Select
Set Rng = Selection
For bJ = 1 To 2
For Each Clls In Rng
If bJ = 1 Then
Clls.Offset(1).EntireRow.Insert
Else
Clls.Offset(1, 1) = Sh.Name
Clls.Offset(1, 6) = Clls.Offset(, 6) '<<=='
End If
Next Clls, bJ
End If
Next Sh
2 ' Tao Danh Sach Khach Hang Duy Nhat:'
Sheets("Tong hop").Select: DgCuoi = [b1].CurrentRegion.Rows.Count
Range("A2:J" & DgCuoi + 9).Clear: Columns("IT:IT").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlUp
Range("IT:IT").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
"IV1"), Unique:=True
Columns("IT:IT").Clear
3 ' Chep Du Lieu Vo Sheets("Tong hop"): '
Lrow = [iV65500].End(xlUp).Row
For bJ = 2 To Lrow 'Chu I bJ Khi Khach Hang Nhieu'
For Each Sh In Worksheets
If Sh.Name <> "Tong hop" Then
Set Rng = Sh.Columns("B:B").Find(what:=Cells(bJ, "IV"), LookIn:=xlValues)
If Not Rng Is Nothing Then
DgCuoi = Rng.Offset(1).End(xlDown).Row
If DgCuoi > 65500 Then DgCuoi = Sh.[a65500].End(xlUp).Row + 1
If Tong = 0 Then
Set SRng = [a65500].End(xlUp).Offset(1, 6) '<<=='
Else
Set bRng = [a65500].End(xlUp).Offset(1, 6) '<<=='
End If
Rng.Offset(, -1).Resize(DgCuoi - Rng.Row, 9).Copy _
Destination:=[a65500].End(xlUp).Offset(1)
Tong = Tong + Rng.Offset(, 5) '<<=='
End If
End If
Next Sh
SRng.Value = Tong: Tong = 0 '<<=='
bRng.Value = "" '<<=='
Next bJ
Columns("IV:Iv").Clear
4 ' Xoa Cac Dong Phu Tro:'
For Each Sh In Worksheets
If Sh.Name <> "Tong hop" Then
Do
Set Rng = Sh.Columns("B:B").Find(what:=Sh.Name, LookIn:=xlValues)
If Rng Is Nothing Then
Exit Do
Else
Rng.EntireRow.Delete
End If
Loop
End If
Next Sh
End Sub
Chỉnh sửa lần cuối bởi điều hành viên:
Cám ơn Bác SA_DQ đã chiếu cố viết lại bài này. Bài trước của Bác thì quá rõ rồi nhưng do trí nhớ của em tồi quá nên xem được câu dưới thì quên mất câu trên, đọc lại câu trên thì chả nhớ nó là câu nào bên dưới vì vậy em mới "thích" kiểu mực hệt này để học theo kiểu "o tròn giống quả trứng gà, ô thì...thì... thì... giống quả trứng gà đội nón". Rất mong được Bác và mọi người thông cảm.
