Gộp điểm bằng VBA

[Thiên Thanh1]

Chào các bạn
nhờ các bạn viết giúp code như nội dung file đính kèm
Cảm ơn các bạn

 

[excel_lv1.5]

Chào các bạn
nhờ các bạn viết giúp code như nội dung file đính kèm
Cảm ơn các bạn

Tôi sài power query

 

[Thiên Thanh1]

Tôi sài power query

Anh viết cho mình bằng Vba được không?

 

[excel_lv1.5]

Anh viết cho mình bằng Vba được không?

Tôi ngán VBA rồi bạn ạ

 

[concogia]

Anh viết cho mình bằng Vba được không?

1) Trong bảng không có Mã học sinh mà chỉ có Tên, có 2 tên trùng ( Xuân Mai & Thanh Thanh ), máy đâu có hiểu được bạn
2) Số lượng học sinh 2 bảng bằng nhau & tên giống nhau hết chứ bạn ?

 

[Thiên Thanh1]

1) Trong bảng không có Mã học sinh mà chỉ có Tên, có 2 tên trùng ( Xuân Mai & Thanh Thanh ), máy đâu có hiểu được bạn
2) Số lượng học sinh 2 bảng bằng nhau & tên giống nhau hết chứ bạn ?

Dạ 2 bảng tên được sắp xếp thứ tự và số lượng như nhau chú ơi.

 

[concogia]

Dạ 2 bảng tên được sắp xếp thứ tự và số lượng như nhau chú ơi.

Bạn kiểm tra thử, bấm vào con mèo
Đang xem Việt Nam đá banh, có gì nói sau
Thân

 

[concogia]

Đang mải xem đá bóng, không xem kỹ, bạn chạy code này cũng được, gọn hơn tý
Thân

Public Sub Noi()
    Dim BangA, BangB, I, Kq, Dau, Rot, iHang, K, Wf
    Rot = "R" & ChrW(7899) & "t"
    Set BangA = Sheets("DS1").Range(Sheets("DS1").[A2], Sheets("DS1").[A5000].End(xlUp)).Resize(, 5)
    Set BangB = Sheets("DS2").Range(Sheets("DS2").[A2], Sheets("DS2").[A5000].End(xlUp)).Resize(, 5)
    Set Wf = Application.WorksheetFunction
    ReDim Kq(1 To BangA.Rows.Count, 1 To 1)
        For I = 1 To BangA.Rows.Count
                K = K + 1
                If BangA(I, 2) <> "R" & ChrW(7899) & "t" Then
                    If BangB(I, 2) <> "R" & ChrW(7899) & "t" Then
                        Kq(K, 1) = Join(Wf.Transpose(Wf.Transpose(BangA(I, 3).Resize(, 3))), ", ") & ", " & Join(Wf.Transpose(Wf.Transpose(BangB(I, 3).Resize(, 3))), ", ")
                    End If
                Else
                        Kq(K, 1) = "R" & ChrW(7899) & "t"
                End If
        Next I
    [I2].Resize(K, 1) = Kq
End Sub

 

[Thiên Thanh1]

Đang mải xem đá bóng, không xem kỹ, bạn chạy code này cũng được, gọn hơn tý
Thân

Public Sub Noi()
    Dim BangA, BangB, I, Kq, Dau, Rot, iHang, K, Wf
    Rot = "R" & ChrW(7899) & "t"
    Set BangA = Sheets("DS1").Range(Sheets("DS1").[A2], Sheets("DS1").[A5000].End(xlUp)).Resize(, 5)
    Set BangB = Sheets("DS2").Range(Sheets("DS2").[A2], Sheets("DS2").[A5000].End(xlUp)).Resize(, 5)
    Set Wf = Application.WorksheetFunction
    ReDim Kq(1 To BangA.Rows.Count, 1 To 1)
        For I = 1 To BangA.Rows.Count
                K = K + 1
                If BangA(I, 2) <> "R" & ChrW(7899) & "t" Then
                    If BangB(I, 2) <> "R" & ChrW(7899) & "t" Then
                        Kq(K, 1) = Join(Wf.Transpose(Wf.Transpose(BangA(I, 3).Resize(, 3))), ", ") & ", " & Join(Wf.Transpose(Wf.Transpose(BangB(I, 3).Resize(, 3))), ", ")
                    End If
                Else
                        Kq(K, 1) = "R" & ChrW(7899) & "t"
                End If
        Next I
    [I2].Resize(K, 1) = Kq
End Sub

Cháu cảm ơn chú
Chúc chú nhiều sức khỏe

 

[Cá ngừ F1]

Tôi sài power query

Theo chủ thớt phải đảm bảo cả 2 DS1, DS2 cùng đậu thì mới gộp đó anh.
Em Filter các ông rớt đi, không biết có đúng ý của tác giả không?

 

[excel_lv1.5]

Theo chủ thớt phải đảm bảo cả 2 DS1, DS2 cùng đậu thì mới gộp đó anh.
Em Filter các ông rớt đi, không biết có đúng ý của tác giả không?

View attachment 266219

Vậy filter bỏ rớt chắc được bạn ạ, không biết có ai 2 trường hợp không, 2 trường hợp thì chỉnh lại chút!

 

[Cá ngừ F1]

Vậy filter bỏ rớt chắc được bạn ạ, không biết có ai 2 trường hợp không, 2 trường hợp thì chỉnh lại chút!

Khả năng rớt do điểm liệt, rớt là rớt luôn không có cơ hội vớt vát