Chuyên đề giải đáp những thắc mắc về code VBA

Liên hệ QC
maytinhvp01

maytinhvp01

Thành viên thường trực
Tham gia
27/7/13
Bài viết
390
Được thích
179
Mình muốn nhờ giải thich câu lệnh " If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c) "
trong ví du:
Public Function LonNhat(Ran As Range)
Dim max As Double, v As Integer, d As Integer, c As Integer
max = Ran.Cells(1, 1)
For d = 1 To Ran.Rows.Count
For c = 1 To Ran.Columns.Count
If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c)
Next c
Next d
v = Tim(max, Ran)
LonNhat = max
End Function
-------------------------------------------------------
[INFO1]Thông báo:
Vì topic này:
http://www.giaiphapexcel.com/forum/...ải-thích-các-code-đề-nghị-các-bạn-gửi-vào-đây
đã quá dài nên BQT đóng lại.
Nay tôi mở topic mới với cùng chủ đề: GIẢI THÍCH NHỮNG THẮC MẮC VỀ CODE
Các bạn nếu có nhu cầu giải thích code, vui lòng post tại đây nhé
NDU96081631
[/INFO1]
 
Chỉnh sửa lần cuối bởi điều hành viên:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Thuyanhanoi đã viết:
Em đang tập viết code VBA. Nhưng nói chung còn quá gà, túm lại là còn chưa hiểu. Mong được mọi người giúp
Private Sub Thongke()
Dim dem As Long, Dic As Object, sArr, dArr(), J As Long, K As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet("Tong_hop")
dem = [BL65000].End(xlUp).Row
For I = 1 To er
If Cells(I, 1) <> "" Then
.Cells(I, 1) = Application.[SUM((Tong_hop!dem>=0)*(Tong_hop!dem<4)]
.Cells(I, 1) = Application.[SUM((Tong_hop!dem>=4)*(Tong_hop!dem<5)]
.Cells(I, 1) = Application.[SUM((Tong_hop!dem>=5)*(Tong_hop!dem<6)]
.Cells(I, 1) = Application.[SUM((Tong_hop!dem>=6)*(Tong_hop!dem<7)]
.Cells(I, 1) = Application.[SUM((Tong_hop!dem>=7)*(Tong_hop!dem<8)]
.Cells(I, 1) = Application.[SUM((Tong_hop!dem>=8)*(Tong_hop!dem<9)]
.Cells(I, 1) = Application.[SUM((Tong_hop!dem>=9)*(Tong_hop!dem<10)]
End If
Next I
End With
End Sub
Chẳng biết kết hợp làm sao?. Làm mãi chẳng được. Muốn gán cho nó vào mảng và dùng vòng lặp để duyệt sau đó lấy kết quả mà chẳng thể làm nổi ..... Rất mong mọi người giúp cho. Thôi thì gửi file đính kèm nhờ mọi người giúp. Xin cảm ơn mọi người rất nhiều.
Nhấp chuột vào đây để mở rộng...

Code theo file của bạn
PHP: 
Sub thongke()
Dim Sheet(), i As Byte, Result(), j As Long, Source(), Col As Byte, ii As Long, jj As Long
Sheet = Array("Hoc_ky", "Tong_hop")
With Sheets("Bang_Phu")
   .[C2:D1000].ClearContents
   Result = .Range(.[B2], .[B65536].End(3)).Resize(, 3).Value
End With
For i = 0 To UBound(Sheet)
   Col = IIf(i = 0, 28, 65)
   With Sheets(Sheet(i))
      Source = .Range(.Cells(10, Col), .Cells(65536, Col).End(3)).Value
   End With
   For ii = 1 To UBound(Result)
      For jj = 1 To UBound(Source)
         If Source(jj, 1) = Result(ii, 1) Then
            Result(ii, i + 2) = Result(ii, i + 2) + 1
         End If
      Next jj
   Next ii
Next
Sheets("Bang_Phu").[B2].Resize(ii - 1, 3) = Result
End Sub
 
Upvote 0
Cảm ơn bạn: Công thức mà mình làm là ở sheet (Bang_phu) rồi, mình không thông kê trên sheet hoc_ky và sheet Tong_hop.
 
Upvote 0
quanghai1969 đã viết:
Code theo file của bạn
PHP: 
Sub thongke()
Dim Sheet(), i As Byte, Result(), j As Long, Source(), Col As Byte, ii As Long, jj As Long
Sheet = Array("Hoc_ky", "Tong_hop")
With Sheets("Bang_Phu")
   .[C2:D1000].ClearContents
   Result = .Range(.[B2], .[B65536].End(3)).Resize(, 3).Value
End With
For i = 0 To UBound(Sheet)
   Col = IIf(i = 0, 28, 65)
   With Sheets(Sheet(i))
      Source = .Range(.Cells(10, Col), .Cells(65536, Col).End(3)).Value
   End With
   For ii = 1 To UBound(Result)
      For jj = 1 To UBound(Source)
         If Source(jj, 1) = Result(ii, 1) Then
            Result(ii, i + 2) = Result(ii, i + 2) + 1
         End If
      Next jj
   Next ii
Next
Sheets("Bang_Phu").[B2].Resize(ii - 1, 3) = Result
End Sub
Nhấp chuột vào đây để mở rộng...
Thầy cho em thêm chỗ này với: Với code trên em chạy thấy có vấn đề như sau thầy chỉnh giúp em với: Ví dụ như tại cột loại giỏi; Xuất sắc và yếu. không có HSSV nào thì gán bằng 0. Em cảm ơn nhiều
 
Lần chỉnh sửa cuối:
Upvote 0
Thuyanhanoi đã viết:
Thầy cho em thêm chỗ này với: Loại nào không có thì gán bằng 0 giúp em với
Nhấp chuột vào đây để mở rộng...
Không cố gắng tự vận động thì đến bao giờ mới tự xử được
PHP: 
Sub thongke()
Dim Sheet(), i As Byte, Result(), j As Long, Source(), Col As Byte, ii As Long, jj As Long
Sheet = Array("Hoc_ky", "Tong_hop")
With Sheets("Bang_Phu")
   .[C2:D1000].ClearContents
   Result = .Range(.[B2], .[B65536].End(3)).Resize(, 3).Value
End With
For i = 0 To UBound(Sheet)
   Col = IIf(i = 0, 28, 65)
   With Sheets(Sheet(i))
      Source = .Range(.Cells(10, Col), .Cells(65536, Col).End(3)).Value
   End With
   For ii = 1 To UBound(Result)
      For jj = 1 To UBound(Source)
         If Source(jj, 1) = Result(ii, 1) Then
            Result(ii, i + 2) = Result(ii, i + 2) + 1
         Else
            If Result(ii, i + 2) = 0 Then Result(ii, i + 2) = 0
         End If
      Next jj
   Next ii
Next
Sheets("Bang_Phu").[B2].Resize(ii - 1, 3) = Result
End Sub
 
Upvote 0
quanghai1969 đã viết:
Không cố gắng tự vận động thì đến bao giờ mới tự xử được
PHP: 
Sub thongke()
Dim Sheet(), i As Byte, Result(), j As Long, Source(), Col As Byte, ii As Long, jj As Long
Sheet = Array("Hoc_ky", "Tong_hop")
With Sheets("Bang_Phu")
   .[C2:D1000].ClearContents
   Result = .Range(.[B2], .[B65536].End(3)).Resize(, 3).Value
End With
For i = 0 To UBound(Sheet)
   Col = IIf(i = 0, 28, 65)
   With Sheets(Sheet(i))
      Source = .Range(.Cells(10, Col), .Cells(65536, Col).End(3)).Value
   End With
   For ii = 1 To UBound(Result)
      For jj = 1 To UBound(Source)
         If Source(jj, 1) = Result(ii, 1) Then
            Result(ii, i + 2) = Result(ii, i + 2) + 1
         Else
            If Result(ii, i + 2) = 0 Then Result(ii, i + 2) = 0
         End If
      Next jj
   Next ii
Next
Sheets("Bang_Phu").[B2].Resize(ii - 1, 3) = Result
End Sub
Nhấp chuột vào đây để mở rộng...
Code của thầy đã ok. Em cảm ơn Thầy nhiều. Em bắt đầu tìm hiểu cũng được tới 2 tháng nay mà chưa được gì hì hì ...
- Nhân đây thầy Cho em hỏi với. Thầy có giúp em code (để gán giá trị của mảng vào một hàng bất kỳ) ví dụ trên cột A8 ở sheet Tổng hợp hoặc sheet học kỳ em nhập vào số 50 chẳng hạn thì tại hàng số 50 đó giá trị của mảng ([B2,C8];[B2,D8] của sheet Bang_phu ) được gán vào dòng 50 tương ứng ở các sheet Tong hợp và học kỳ. Em cảm ơn rất nhiều. Mà vấn đề gán giá trí vào một hàng mà ta cho em vẫn chưa tìm thấy trên diễn đàn.
 
Lần chỉnh sửa cuối:
Upvote 0
Thuyanhanoi đã viết:
Thầy cho em thêm chỗ này với: Với code trên em chạy thấy có vấn đề như sau thầy chỉnh giúp em với: Ví dụ như tại cột loại giỏi; Xuất sắc và yếu. không có HSSV nào thì gán bằng 0. Em cảm ơn nhiều
Nhấp chuột vào đây để mở rộng...
Với dữ liệu thật của bạn thì tôi viết code "dài thoòng" này hy vọng bạn xài được cho file thật của bạn, chứ bạn đưa file không thật rồi bảo là "code không chạy" mệt lắm.
Mã: 
Public Sub TK_BangPhu()Dim ArrHK(), ArrTH(), dArr(), i As Long, XS As String, Gioi As String, Kha As String, TBKha As String, TB As String, Yeu As String, Kem As String
With Sheets("Tong_hop")
    ArrTH = .Range(.[BM10], .[BM65000].End(xlUp)).Value
End With
With Sheets("Hoc_Ky")
    ArrHK = .Range(.[AB10], .[AB65000].End(xlUp)).Value
End With
With Sheets("Bang_phu")
    .Range("C2:D8").Value = 0
    dArr = .Range("C2:D8").Value
    Kem = .[B2].Value
    Yeu = .[B3].Value
    TB = .[B4].Value
    TBKha = .[B5].Value
    Kha = .[B6].Value
    Gioi = .[B7].Value
    XS = .[B8].Value
    For i = 1 To UBound(ArrHK, 1)
        If ArrHK(i, 1) = Kem Then
            dArr(1, 1) = dArr(1, 1) + 1
        ElseIf ArrHK(i, 1) = Yeu Then
            dArr(2, 1) = dArr(2, 1) + 1
        ElseIf ArrHK(i, 1) = TB Then
            dArr(3, 1) = dArr(3, 1) + 1
        ElseIf ArrHK(i, 1) = TBKha Then
            dArr(4, 1) = dArr(4, 1) + 1
        ElseIf ArrHK(i, 1) = Kha Then
            dArr(5, 1) = dArr(5, 1) + 1
        ElseIf ArrHK(i, 1) = Gioi Then
            dArr(6, 1) = dArr(6, 1) + 1
        ElseIf ArrHK(i, 1) = XS Then
            dArr(7, 1) = dArr(7, 1) + 1
        End If
    Next i
    For i = 1 To UBound(ArrTH, 1)
        If ArrTH(i, 1) = Kem Then
            dArr(1, 2) = dArr(1, 2) + 1
        ElseIf ArrTH(i, 1) = Yeu Then
            dArr(2, 2) = dArr(2, 2) + 1
        ElseIf ArrTH(i, 1) = TB Then
            dArr(3, 2) = dArr(3, 2) + 1
        ElseIf ArrTH(i, 1) = TBKha Then
            dArr(4, 2) = dArr(4, 2) + 1
        ElseIf ArrTH(i, 1) = Kha Then
            dArr(5, 2) = dArr(5, 2) + 1
        ElseIf ArrTH(i, 1) = Gioi Then
            dArr(6, 2) = dArr(6, 2) + 1
        ElseIf ArrTH(i, 1) = XS Then
            dArr(7, 2) = dArr(7, 2) + 1
        End If
    Next i
    .[C2:D8].Value = dArr
End With
End Sub
 

File đính kèm

  • BT2.rar
    32.5 KB · Đọc: 61
Lần chỉnh sửa cuối:
Upvote 0
Ba Tê đã viết:
Với dữ liệu thật của bạn thì tôi viết code "dài thoòng" này hy vọng bạn xài được cho file thật của bạn, chứ bạn đưa file không thật rồi bảo là "code không chạy" mệt lắm.
Mã: 
Public Sub TK_BangPhu()Dim ArrHK(), ArrTH(), dArr(), i As Long, XS As String, Gioi As String, Kha As String, TBKha As String, TB As String, Yeu As String, Kem As String
With Sheets("Tong_hop")
    ArrTH = .Range(.[BM10], .[BM65000].End(xlUp)).Value
End With
With Sheets("Hoc_Ky")
    ArrHK = .Range(.[AB10], .[AB65000].End(xlUp)).Value
End With
With Sheets("Bang_phu")
    .Range("C2:D8").Value = 0
    dArr = .Range("C2:D8").Value
    Kem = .[B2].Value
    Yeu = .[B3].Value
    TB = .[B4].Value
    TBKha = .[B5].Value
    Kha = .[B6].Value
    Gioi = .[B7].Value
    XS = .[B8].Value
    For i = 1 To UBound(ArrHK, 1)
        If ArrHK(i, 1) = Kem Then
            dArr(1, 1) = dArr(1, 1) + 1
        ElseIf ArrHK(i, 1) = Yeu Then
            dArr(2, 1) = dArr(2, 1) + 1
        ElseIf ArrHK(i, 1) = TB Then
            dArr(3, 1) = dArr(3, 1) + 1
        ElseIf ArrHK(i, 1) = TBKha Then
            dArr(4, 1) = dArr(4, 1) + 1
        ElseIf ArrHK(i, 1) = Kha Then
            dArr(5, 1) = dArr(5, 1) + 1
        ElseIf ArrHK(i, 1) = Gioi Then
            dArr(6, 1) = dArr(6, 1) + 1
        ElseIf ArrHK(i, 1) = XS Then
            dArr(7, 1) = dArr(7, 1) + 1
        End If
    Next i
    For i = 1 To UBound(ArrTH, 1)
        If ArrTH(i, 1) = Kem Then
            dArr(1, 2) = dArr(1, 2) + 1
        ElseIf ArrTH(i, 1) = Yeu Then
            dArr(2, 2) = dArr(2, 2) + 1
        ElseIf ArrTH(i, 1) = TB Then
            dArr(3, 2) = dArr(3, 2) + 1
        ElseIf ArrTH(i, 1) = TBKha Then
            dArr(4, 2) = dArr(4, 2) + 1
        ElseIf ArrTH(i, 1) = Kha Then
            dArr(5, 2) = dArr(5, 2) + 1
        ElseIf ArrTH(i, 1) = Gioi Then
            dArr(6, 2) = dArr(6, 2) + 1
        ElseIf ArrTH(i, 1) = XS Then
            dArr(7, 2) = dArr(7, 2) + 1
        End If
    Next i
    .[C2:D8].Value = dArr
End With
End Sub
Nhấp chuột vào đây để mở rộng...
- Đọc cả 2 tháng nay em mới gán được form controls Thầy ạ! mà listbox còn chưa được.
- Em dùng cách gán qua gán lại này là để tổng hợp số lượng xếp loại. Sau đó lại trả lại kết quả vào sheet tương ứng. Nhưng vì chưa biết số lương HSSV là bao nhiều do vậy mới lựa chọn phương án đó. Khi biết được số lượng HSSV cụ thể cuối cùng ở dòng bào nhiêu (vị dụ học sinh cuối cùng nằm ở dòng 100 thì em gán giá trị từ sheet Bang_phu sang là vòa dòng thứ 102) Khi biết được số lượng rồi thì gán trả lại cho nó kết quả tương ứng, mà lại không phải xử lý phông chữ. Nghi vậy mà loay hoay mãi không xong buồn chứ híc híc.
 
Lần chỉnh sửa cuối:
Upvote 0
Giải thích hộ em code này

Em chưa học qua VBA và các loại code
Em có đăng diễn đàn để xin trợ giúp việc tìm kiếm cách dò tìm nhiều điều kiện và cho ra nhiều kết quả.
Có một bạn chỉ em cách tạo code hàm LietKe nhưng em áp dụng vào những dữ liệu khác không được vì không hiểu code để tuỳ biến
Ai giải thích hộ em, ý nghĩa của từng dòng trong code, em cảm ơn nhiều ạ!
 

File đính kèm

  • gpeUDF.rar
    9.8 KB · Đọc: 24
Upvote 0
tuyetphale đã viết:
Em chưa học qua VBA và các loại code
Em có đăng diễn đàn để xin trợ giúp việc tìm kiếm cách dò tìm nhiều điều kiện và cho ra nhiều kết quả.
Có một bạn chỉ em cách tạo code hàm LietKe nhưng em áp dụng vào những dữ liệu khác không được vì không hiểu code để tuỳ biến
Ai giải thích hộ em, ý nghĩa của từng dòng trong code, em cảm ơn nhiều ạ!
Nhấp chuột vào đây để mở rộng...
Với bài này thì chỉ cần 3 dòng code như thế này
PHP: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$G$2" Or Target.Address = "$H$2" Then
   [A3:D10000].AdvancedFilter 2, [G1:H2], [G3:J3]
End If
End Sub
 

File đính kèm

  • TraDiaDiem.rar
    9.3 KB · Đọc: 55
Upvote 0
.....

Ai sửa dùm em file này theo cách làm của bác quanghai1969 giùm cái
Vừa save bị lỗi gì đó, mà vừa không chạy code được
Ai có khả năng giúp giùm em cái, em cần gấp
 
Lần chỉnh sửa cuối:
Upvote 0
Chào các anh/chị , nhờ anh/chị trợ giúp

Hiện tại e có một bảng phiếu in lương cho nhân viên
Các thông tin trong phiếu in lương được chạy bằng hàm vlookup theo mã nhân viên có dạng NSX ( trong đó X = 1, 2, 3 .... n)
Ý tưởng: muốn in nhiều nhân viên cùng một lúc bằng cách nhập mã nhân viên cuối VD NS10 , nhấn vào nút in sẽ in lần lượt từ NS1 -> NS10

Em đã tạo một nút in bằng câu lệnh như bên dưới.

Sheets("luong").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=2

Nhưng mỗi lần in lại phải thay mã nhân viên để in nhân viên tiếp theo. Vậy em phải thêm vòng lặp như thế nào để có thể in tự động lần lượt từng nhân viên ạ!
Em cảm ơn!
 
Upvote 0
nam_lp86 đã viết:
Chào các anh/chị , nhờ anh/chị trợ giúp

Hiện tại e có một bảng phiếu in lương cho nhân viên
Các thông tin trong phiếu in lương được chạy bằng hàm vlookup theo mã nhân viên có dạng NSX ( trong đó X = 1, 2, 3 .... n)
Ý tưởng: muốn in nhiều nhân viên cùng một lúc bằng cách nhập mã nhân viên cuối VD NS10 , nhấn vào nút in sẽ in lần lượt từ NS1 -> NS10

Em đã tạo một nút in bằng câu lệnh như bên dưới.

Sheets("luong").Select
ActiveWindow.SelectedSheets.PrintOut Copies:=2

Nhưng mỗi lần in lại phải thay mã nhân viên để in nhân viên tiếp theo. Vậy em phải thêm vòng lặp như thế nào để có thể in tự động lần lượt từng nhân viên ạ!
Em cảm ơn!
Nhấp chuột vào đây để mở rộng...
Bạn chưa biết lập trình vậy nên sử dụng các công cụ có sẵn. Bạn có thể tham khảo tiện ích in form hàng loạt, link tại chữ ký của tôi. Trong topic có ví dụ về phiếu lương hy vọng sẽ ứng dụng được cho công việc của bạn!
 
Upvote 0
Ba Tê đã viết:
Với dữ liệu thật của bạn thì tôi viết code "dài thoòng" này hy vọng bạn xài được cho file thật của bạn, chứ bạn đưa file không thật rồi bảo là "code không chạy" mệt lắm.
Mã: 
Public Sub TK_BangPhu()Dim ArrHK(), ArrTH(), dArr(), i As Long, XS As String, Gioi As String, Kha As String, TBKha As String, TB As String, Yeu As String, Kem As String
With Sheets("Tong_hop")
    ArrTH = .Range(.[BM10], .[BM65000].End(xlUp)).Value
End With
With Sheets("Hoc_Ky")
    ArrHK = .Range(.[AB10], .[AB65000].End(xlUp)).Value
End With
With Sheets("Bang_phu")
    .Range("C2:D8").Value = 0
    dArr = .Range("C2:D8").Value
    Kem = .[B2].Value
    Yeu = .[B3].Value
    TB = .[B4].Value
    TBKha = .[B5].Value
    Kha = .[B6].Value
    Gioi = .[B7].Value
    XS = .[B8].Value
    For i = 1 To UBound(ArrHK, 1)
        If ArrHK(i, 1) = Kem Then
            dArr(1, 1) = dArr(1, 1) + 1
        ElseIf ArrHK(i, 1) = Yeu Then
            dArr(2, 1) = dArr(2, 1) + 1
        ElseIf ArrHK(i, 1) = TB Then
            dArr(3, 1) = dArr(3, 1) + 1
        ElseIf ArrHK(i, 1) = TBKha Then
            dArr(4, 1) = dArr(4, 1) + 1
        ElseIf ArrHK(i, 1) = Kha Then
            dArr(5, 1) = dArr(5, 1) + 1
        ElseIf ArrHK(i, 1) = Gioi Then
            dArr(6, 1) = dArr(6, 1) + 1
        ElseIf ArrHK(i, 1) = XS Then
            dArr(7, 1) = dArr(7, 1) + 1
        End If
    Next i
    For i = 1 To UBound(ArrTH, 1)
        If ArrTH(i, 1) = Kem Then
            dArr(1, 2) = dArr(1, 2) + 1
        ElseIf ArrTH(i, 1) = Yeu Then
            dArr(2, 2) = dArr(2, 2) + 1
        ElseIf ArrTH(i, 1) = TB Then
            dArr(3, 2) = dArr(3, 2) + 1
        ElseIf ArrTH(i, 1) = TBKha Then
            dArr(4, 2) = dArr(4, 2) + 1
        ElseIf ArrTH(i, 1) = Kha Then
            dArr(5, 2) = dArr(5, 2) + 1
        ElseIf ArrTH(i, 1) = Gioi Then
            dArr(6, 2) = dArr(6, 2) + 1
        ElseIf ArrTH(i, 1) = XS Then
            dArr(7, 2) = dArr(7, 2) + 1
        End If
    Next i
    .[C2:D8].Value = dArr
End With
End Sub
Nhấp chuột vào đây để mở rộng...

Trường hợp như code của bác Ba Tê, vì chỉ so sánh với 1 giá trị, nên em nghĩ là mình dùng Select Case vừa ngắn gọn, vừa chạy nhanh:

Mã: 
Public Sub TK_BangPhu()

    Dim ArrHK(), ArrTH(), dArr()
    Dim XS As String, Gioi As String, Kha As String, TBKha As String, _
        TB As String, Yeu As String, Kem As String
    Dim i As Long
    
    With Sheets("Tong_hop")
        ArrTH = Range(.Range("BM10"), .Range("BM65536").End(xlUp))
    End With

    With Sheets("Hoc_Ky")
        ArrHK = Range(.Range("AB10"), .Range("AB65536").End(xlUp))
    End With
    
    With Sheets("Bang_phu")
        .Range("C2:D8") = 0
        dArr = .Range("C2:D8").Value
        Kem = .Range("B2")
        Yeu = .Range("B3")
        TB = .Range("B4")
        TBKha = .Range("B5")
        Kha = .Range("B6")
        Gioi = .Range("B7")
        XS = .Range("B8")
    End With
    
    For i = 1 To UBound(ArrHK, 1)
        Select Case ArrHK(i, 1)
            Case Kem: dArr(1, 1) = dArr(1, 1) + 1
            Case Yeu: dArr(2, 1) = dArr(2, 1) + 1
            Case TB: dArr(3, 1) = dArr(3, 1) + 1
            Case TBKha: dArr(4, 1) = dArr(4, 1) + 1
            Case Kha: dArr(5, 1) = dArr(5, 1) + 1
            Case Gioi: dArr(6, 1) = dArr(6, 1) + 1
            Case XS: dArr(7, 1) = dArr(7, 1) + 1
        End Select
    Next i
    
    For i = 1 To UBound(ArrTH, 1)
        Select Case ArrTH(i, 1)
            Case Kem: dArr(1, 2) = dArr(1, 2) + 1
            Case Yeu: dArr(2, 2) = dArr(2, 2) + 1
            Case TB: dArr(3, 2) = dArr(3, 2) + 1
            Case TBKha: dArr(4, 2) = dArr(4, 2) + 1
            Case Kha: dArr(5, 2) = dArr(5, 2) + 1
            Case Gioi: dArr(6, 2) = dArr(6, 2) + 1
            Case XS: dArr(7, 2) = dArr(7, 2) + 1
        End Select
    Next i
    
    Sheets("Bang_phu").Range("C2:D8") = dArr
    
End Sub

Nhưng với bài này, mình chỉ dùng công thức (hàm COUNTIF, nếu cần, thêm cái name động) thì OK, khỏi cần "cót két" gì hết á!
 
Lần chỉnh sửa cuối:
Upvote 0
Hai cái vòng lặp trên code gần in hệt nhau. Ta có thể hoặc đẩy chúng ra hàm con (gọi 2 lần), hoặn lợi dụng tính chất uyển chuyển của array để gộp code lại.

Mã: 
...
Dim ArrHK(), ArrTH(), dArr(), bdArr(), thArr()
Dim bd as Integer ' loại bảng điểm
Dim sTH as Integer ' số thứ hạng (7)
...
' copy 7 ô xếp điểm sang thArr() - Gioi, Kem, vv...
sTH = UBound(thArr) ' trữ trị này để tránh lặp lại nhiều lần
...

For bd = 1 to 2 ' chạy 2 lượt, 1 = tổng hợp; 2 = học kỳ

if (bd=1) Then
    With Sheets("Tong_hop")
        bdArr = Range(.Range("BM10"), .Range("BM65536").End(xlUp))
    End With
Else
    With Sheets("Hoc_Ky")
        bdArr = Range(.Range("AB10"), .Range("AB65536").End(xlUp))
    End With
End If

For i = 1 To UBound(bdArr, 1) ' vòng lặp qua vùng chứa điểm
    For j = 1 to sTH ' vòng lặp so điểm để tìm hạng
        If (bdArr(i, 1) = thArr(j) Then
            dArr(j, bd) = dArr(j, bd) + 1
            Exit For ' đã có hạng rồi, không cần so nữa
        End If
    Next j
Next i

Next bd
 
Upvote 0
Nhờ các anh chị giúp,

Em sử dụng đoạn code sau để hiển thị thông tin sinh nhật sau 1 tháng và thông tin nhân viên muốn tìm kiếm

Sub Sinhnhat()
Dim SrcRng As Range, Crit1 As Range
With Sheets("Data")
Set SrcRng = .Range(.[A7], .[A65536].End(xlUp)).Resize(, 50)
Set Crit1 = .Range("B2:B3")
End With
Sheets("SinhNhat").Range("A7:AX500").Clear
SrcRng.AdvancedFilter 2, Crit1, Sheets("SinhNhat").Range("A7")
Sheets("SinhNhat").Select
End Sub
Sub NhanVien()
Dim SrcRng1 As Range, Crit2 As Range
With Sheets("Data")
Set SrcRng1 = .Range(.[A7], .[A65536].End(xlUp)).Resize(, 50)
Set Crit2 = .Range("C2:C3")
End With
Sheets("NhanVien").Range("A7:AX500").Clear
SrcRng1.AdvancedFilter 2, Crit2, Sheets("NhanVien").Range("A7")
Sheets("NhanVien").Select
End Sub

Không biết em làm sai chỗ nào mà phần sinh nhật thì chạy còn phần nhân viên thì không chạy
Link file: http://www.mediafire.com/download/3cvmb958x4d8xds/formNhanSu.xlsm
 
Upvote 0
Chào anh chị, nhờ các anh chị giúp em giải thích đoạn code này với, hiện tại công việc của em là lập tiến độ dự án, nên sử dụng một file excel của đàn anh đi trước, nhưng không hiểu ý nghĩa các đoạn code này mong mọi người giúp, em xin chân thành cám ơn.

Sub spandek700()
Sheets("SPANDEK 700").Activate
Range(Cells(5, 1), Cells(100, 11)).Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection
.Value = ""
End With
J = 5
For i = 7 To 400
Sheets("MASTER PLAN").Activate
If Cells(i, 10) = "SPANDEK" Then
If Cells(i, 20) <> "DONE" And Cells(i, 11) = "Roll-form at factory" Then
a = Cells(i, 23)
b = Cells(i, 5)
c = Cells(i, 9)
d = Cells(i, 14)
e = Cells(i, 29)
f = Cells(i, 15)
G = Cells(i, 3) 'item code
H = Cells(i, 1) 'project code
K = Cells(i, 19) 'ngay xuong BOQ
Sheets("SPANDEK 700").Activate
Cells(J, 1) = a
Cells(J, 2) = b
Cells(J, 3) = c
Cells(J, 4) = d
Cells(J, 5) = e
Cells(J, 6) = f
Cells(J, 8) = H
Cells(J, 9) = G
Cells(J, 11) = K
J = J + 1
End If
End If
Next i
For i = 7 To 500
Sheets("MASTER PLAN").Activate
If Cells(i, 10) = "KLIPLOK" Then
If Cells(i, 20) <> "DONE" And Cells(i, 11) = "Roll-form at factory" Then
a = Cells(i, 23)
b = Cells(i, 5)
c = Cells(i, 9)
d = Cells(i, 14)
e = Cells(i, 29)
f = Cells(i, 15)
G = Cells(i, 3) 'item code
H = Cells(i, 1) 'project code
K = Cells(i, 19) 'ngay xuong BOQ
Sheets("SPANDEK 700").Activate
Cells(J, 1) = a
Cells(J, 2) = b
Cells(J, 3) = c
Cells(J, 4) = d
Cells(J, 5) = e
Cells(J, 6) = f
Cells(J, 8) = H
Cells(J, 9) = G
Cells(J, 11) = K
J = J + 1
End If
End If
Next i
Sheets("SPANDEK 700").Activate
End Sub
Sub resetsp700()
Sheets("CC SPANDEK 700").Activate
Range(Cells(5, 8), Cells(256, 256)).Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
With Selection
.Value = ""
End With
End Sub
 
Upvote 0
Em có đoạn code VBA bên dưới, nhờ ACE GPE giải thích giúp em với

Sub UpdatePT_AllShts()
Dim pt As PivotTable
For Each ws In Sheets
For Each pt In ws.PivotTables
ws.PivotTables(pt.Name).PivotCache.Refresh
Next pt
Next ws
End Sub

Thank all!
 
Upvote 0
mhieuit đã viết:
Em có đoạn code VBA bên dưới, nhờ ACE GPE giải thích giúp em với

Sub UpdatePT_AllShts()
Dim pt As PivotTable
For Each ws In Sheets
For Each pt In ws.PivotTables
ws.PivotTables(pt.Name).PivotCache.Refresh
Next pt
Next ws
End Sub

Thank all!
Nhấp chuột vào đây để mở rộng...

Đây là một thủ tục để Refresh các PivotTable ở các sheet.

Với thủ tục này còn thiếu khai báo một biến WorkSheet: ws

Dòng For đầu tiên duyệt qua các Worksheet.

Dòng For thứ 2 duyệt qua các Pivot trong sheet được duyệt qua

Dòng trong vòng lặp duyệt qua là mỗi Pivot thực thi lệnh Refresh

Các Next lần lượt duyệt qua hết các Pivot table rồi duyệt qua các sheet khác cho đến hết.

Code chỉ đơn giản vậy thôi.
 
Upvote 0
Sub UpdatePT_AllShts()
Dim pt As PivotTable
Dim ws As Worksheet
For Each ws In Sheets
For Each pt In ws.PivotTables
ws.PivotTables(pt.Name).PivotCache.Refresh
Next pt
Next ws
End Sub

Dòng code em in đậm là đúng phải không anh,
code (pt.Name) trong ws.PivotTables(pt.Name).PivotCache.Refresh là gì vậy anh.

Thank.
 
Upvote 0
mhieuit đã viết:
Sub UpdatePT_AllShts()
Dim pt As PivotTable
Dim ws As Worksheet
For Each ws In Sheets
For Each pt In ws.PivotTables
ws.PivotTables(pt.Name).PivotCache.Refresh
Next pt
Next ws
End Sub

Dòng code em in đậm là đúng phải không anh,
code (pt.Name) trong ws.PivotTables(pt.Name).PivotCache.Refresh là gì vậy anh.

Thank.
Nhấp chuột vào đây để mở rộng...

Một trong các Worksheet Method có PivotTables và đối số của nó phải là một Index (có thể là một tên của Pvtbl hoặc có thể là một chỉ số của Pvtbl)

Một trong các phương thức của PivotTables là PivotCache v.v...

Để biết thêm chi tiết, bạn đặt con trỏ đến một phương thức nào đó rồi nhấn F1 để được Help hướng dẫn cụ thể cho bạn (nếu bạn biết tiếng Anh).
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

C
Xin công thức xếp loại có điều kiện.
Trả lời
2
Đọc
88
VetMini
V
8
  • Question
Xin giúp: Nhóm (group data) các dòng trong bảng tính
Trả lời
12
Đọc
468
ptm0412
ptm0412
hongquan93vn
Tìm công thức có thể đánh STT của giá trị mỗi lần xuất hiện
2
Trả lời
28
Đọc
575
ptm0412
ptm0412
T
  • Đã khóa
Tìm một bạn có kinh nghiệm về Excel
    • Cười
Trả lời
0
Đọc
95
tinhnhi1202
T
H
  • Question
Code VBA cộng tổng trên bảng CĐKT
Trả lời
4
Đọc
150
vak1590
vak1590
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom