Lấy danh sách hỗn hợp từ DS có sẵn

diemvuongvathuongde · 5/8/08

Chào các bác, em có 01 vấn đề cần thực hiện mà nghĩ mãi chưa ra được. Lên đây mong các bác giúp đỡ.
Có danh sách gồm 3 cột

Mã:

Mã         Đội               Tổ
M011     Đoi1              ToA
M021     Đoi2              ToB
M022     Đoi2              ToC
M031     Đoi3              ToD
M041     Đoi4              ToE
M042     Đoi4              ToF
M043     Đoi4              ToG
M051     Đoi5              ToH

Em cần đưa ra danh sách như sau (Dùng VBA)

Mã:

Mã            Tổ/Đội
M011         ToA
M021         ToB
M022         ToC
M02           Đoi2
M031         ToD
...

Và có file đính kèm.
Cảm ơn các bác trước.

LikeIt · 5/8/08

Mình nghĩ cái này bạn thử dùng privot table cũng làm đc, chưa cần đến VBA

SA_DQ · 5/8/08

Nếu cần VBA thì có VBA, như sau

Mã:

Option Explicit
[B]Sub ToHop()[/B]
1 Dim lRow As Long, Zw As Long
 Dim JwZ As Integer, Jj As Integer
3 Dim Rng As Range
 [e1] = [a1]:        [f1] = [C1] & "/" & [B1]
5 lRow = [A65500].End(xlUp).Row
 Range("E2:F" & lRow * 9).Clear
7 For Zw = 2 To lRow
   If Zw = 2 Then
9      [e2] = [a2]:      [f2] = [c2]
   Else
11      With Cells(Zw, 1)
         Jj = CInt(Mid(.Offset(-1), 2))
13         If Zw > 3 Then JwZ = CInt(Mid(.Offset(-2), 2))
         Set Rng = Range("E" & [e65500].End(xlUp).Row + 1)
15         If Jj \ 10 + 1 = CInt(Mid(.Value, 2)) \ 10 And _
            CInt(Mid(.Value, 2)) Mod 10 = 1 And _
            (.Row <> 3 And Jj - 1 = JwZ) Then
16            Rng = Mid(.Offset(-1), 1, Len(.Offset(-1)) - 1)
            Rng.Offset(, 1) = .Offset(-1, 1)
18            Rng.Resize(, 2).Interior.ColorIndex = 39
            Set Rng = Rng.Offset(1)
20         End If
         Rng = .Value:           Rng.Offset(, 1) = .Offset(, 2)
22      End With
   End If
24 Next Zw
[B]End Sub[/B]

diemvuongvathuongde · 5/8/08

Cảm ơn các bác đã giúp đỡ. Nhưng đọc đoạn code này em chưa hiểu lắm, các bác mô tả bằng ngôn ngữ thông thường đoạn sau giúp em nhé.

Mã:

 For Zw = 2 To lRow
   If Zw = 2 Then
      [e2] = [a2]:      [f2] = [c2]
   Else
      With Cells(Zw, 1)
         Jj = CInt(Mid(.Offset(-1), 2))
         If Zw > 3 Then JwZ = CInt(Mid(.Offset(-2), 2))
         Set Rng = Range("E" & [e65500].End(xlUp).Row + 1)
         If Jj \ 10 + 1 = CInt(Mid(.Value, 2)) \ 10 And _
            CInt(Mid(.Value, 2)) Mod 10 = 1 And _
            (.Row <> 3 And Jj - 1 = JwZ) Then
            Rng = Mid(.Offset(-1), 1, Len(.Offset(-1)) - 1)
            Rng.Offset(, 1) = .Offset(-1, 1)
            Rng.Resize(, 2).Interior.ColorIndex = 39
            Set Rng = Rng.Offset(1)
         End If
         Rng = .Value:           Rng.Offset(, 1) = .Offset(, 2)
      End With
   End If
 Next Zw

sealand · 5/8/08

Tôi không hiểu là bạn muốn tạo 1 danh sách hỗn hợp cả tổ lẫn đội hay là căn cứ mã để tìm ra tổ nào, đội nào? Vấn đề này hoàn toàn có thể dùng công thức và tham khảo bài viết của anhtuan1066,boyxin,hoangdanh, ca_dafi...khá hay

ndu96081631 · 5/8/08

sealand đã viết:
Tôi không hiểu là bạn muốn tạo 1 danh sách hỗn hợp cả tổ lẫn đội hay là căn cứ mã để tìm ra tổ nào, đội nào? Vấn đề này hoàn toàn có thể dùng công thức và tham khảo bài viết của anhtuan1066,boyxin,hoangdanh, ca_dafi...khá hay

Tôi nhìn file yêu cầu mà cũng không tìm ra được quy luật của vấn đề là nằm ở chổ nào?
M02 rồi M04.... vậy M01, M03 và M05 thì thế nào?
Hoàn toàn không nắm bắt được vấn đề

SA_DQ · 5/8/08

diemvuongvathuongde đã viết:
Cảm ơn các bác đã giúp đỡ. Nhưng đọc đoạn code này em chưa hiểu lắm, các bác mô tả bằng ngôn ngữ thông thường đoạn sau giúp em nhé.

Mình đã đánh số vô các dòng lệnh, để chúng ta tiện trong trao đổi;
Từ dòng 1-dòng 3: khai báo các biến cần thiết, gồm 2 biến kiểu Long để làm việc với các dòng trong trang tính; 1 biến kiểu Range & hai biến kiểu Integer;
D4: Chép tiêu đề cột sang;
D5: Dòng cuối chứa dữ liệu gán vô tên biến lRow
D7

24: Tạo vòng lặp duyệt toàn bộ lần lượt từ trên xuống, dữ liệu cột 'A'
D8 Nếu biến vòng lặp =2 (Con trỏ đang ở d2 - cụ thể là 'A2')
thì thực hiện 2 lệnh gán tại dòng 9
Nếu không thì thực hiện các lệnh từ D11-D23
D11: kích hoạt ô cốt 'A' có số dòng là Zw
D12: dữ liệu của ô trên ô kích hoạt 1 ô, đem cắt từ vị trí thứ 2, biến nó thành dạng số & gán vô biến integer Jj
D13: Nếu chỉ số dòng > 3 (từ 'A4' trở lện) thì (giống như D12) nhưng với ô trên ô hiện hành 1 ô ( Nếu ô HH là 'A5' thì phần trị số trong ô 'A3' sẽ gán vô biến Integer thứ hai); (Thêm biến này để dễ nhìn chương trình, tiện trong phát hiện lỗi chính tả!)
D14: Ô cuối cùng của cột 'E' có dữ liệu ta đem gán vô biến kiểu Range đã khai báo.
D15: (Nếu trị trong Jj đem chia lấy phần nguyên, sau đó + 1 mà bằng với phần số trị của dữ liệu ô HH) và (trị số cuối của ô HH = 1) Và (chỉ số dòng ô HH # 3 và Jj-1 = Jwz thì thực hiện các dòng lệnh từ D16-20 ( JwZ là phần số của ô cách ô HH 1 ô phía trên)
(Thực tế, đây là ~ điều kiện để chép đội)
D16: ô Rng được gán trị trích từ ô trên ô HH, nhưng cắt số cuối. VD 'C0215' thì còn 'C021'
D17: ô kền ngay ơ Rng được gán tên đội: Bên phải ô HH nhưng trên 1 dòng
D18 2 ô vừa gán trị này được tô màu tím nhạt;
D19 Gán lại biến Rng xuống dòng dưới cùng cột với Rng trước đó;
D21 Chép tổ bình thường

Chúc bạn thành công!

chibi · 14/8/08

Bài toán trên cũng rất thực tế. Tôi lấy ví dụ: Với cơ quan Phòng GD-ĐT thường phải tổng hợp số liệu từ các trường, các trường này nằm trên các xã, phường, thị trấn. Ví dụ trên sẽ đưa ra một danh sách gồm tên trường và tên xã (cả mã nữa), nếu xã nào có 1 trường thì không có tên xã ở cuối.
Áp dụng vào bài cụ thể trên, tôi có đoạn code

Mã:

[SIZE=3][FONT=Times New Roman]Sub creat_list ()[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    Dim eRow As Long: Dim i As Integer: Dim iRow As Long[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    eRow = [A2].End(xlDown).Row[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    iRow = 2[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    For i = 2 To eRow[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]        Range("E" & iRow).Value = Range("A" & i).Value[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]        Range("F" & iRow).Value = Range("C" & i).Value[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]        If Left(Range("A" & i).Value, 3) = Left(Range("A" & i - 1).Value, 3) And _[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]           Left(Range("A" & i).Value, 3) <> Left(Range("A" & i + 1).Value, 3) Then[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]            iRow = iRow + 1[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]            Range("E" & iRow).Value = Left(Range("A" & i).Value, 3)[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]            Range("F" & iRow).Value = Range("B" & i).Value[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]        End If[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]            iRow = iRow + 1[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]    Next[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3]End Sub

[/SIZE][/FONT]

SA_DQ · 14/8/08

Ở khía cạnh khác, Code của bạn có thể còn cải tiến, ngỏ hầu tăng tốc

chibi đã viết:

Bài toán trên cũng rất thực tế. . . . .

Mã:

[SIZE=3][FONT=Times New Roman][B]Sub creat_list ()[/B][/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]  Dim eRow As Long: Dim i As Integer: Dim iRow As Long[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]  eRow = [A2].End(xlDown).Row[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]  iRow = 2[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]  For i = 2 To eRow[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]      Range("E" & iRow).Value = Range("A" & i).Value[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]      Range("F" & iRow).Value = Range("C" & i).Value[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]      If Left(Range("A" & i).Value, 3) = Left(Range("A" & i - 1).Value, 3) And _[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]         Left(Range("A" & i).Value, 3) <> Left(Range("A" & i + 1).Value, 3) Then[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]          iRow = iRow + 1[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]          Range("E" & iRow).Value = Left(Range("A" & i).Value, 3)[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]          Range("F" & iRow).Value = Range("B" & i).Value[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]      End If[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]          iRow = iRow + 1[/FONT][/SIZE]
[SIZE=3][FONT=Times New Roman]  Next[/FONT][/SIZE]
[FONT=Times New Roman][SIZE=3][B]End Sub[/B][/SIZE][/FONT]

Theo mình, khi bạn làm việc trong vòng lặp với đối tượng Ranges, thì nên dùng thuộc tính Offset(R,C) sẽ dễ nhìn hơn;
Hơn nữa, nếu bạn dùng cú pháp With . . . End With sẽ thêm nhanh hơn;

PHP:

   For i = 2 To eRow
      With Range("A" & i)
          .Offset(, 4) = .Value
          .Offset(,5) = .Offset(, 2).Value
          .Offset(,6) = .Offset(, 2).Value
          If Left(.Value, 3) = Left( .Offset( i - 1).Value, 3) And _
                Left(.Value, 3) <> Left( .Offset( i + 1).Value, 3) Then
                iRow = iRow + 1
                .Offset(, 4).Value = Left(.Value, 3)
                .Offset(, 5).Value = .Offset( , 1).Value
           End If
           iRow = iRow + 1
       End With
   Next

Chúc vui vẻ!

boyxin · 14/8/08

ndu96081631 đã viết:
Tôi nhìn file yêu cầu mà cũng không tìm ra được quy luật của vấn đề là nằm ở chổ nào?
M02 rồi M04.... vậy M01, M03 và M05 thì thế nào?
Hoàn toàn không nắm bắt được vấn đề

| A | B | C | D | E | F | G = theo boyxin nghĩ
1|Mã|Đội|Tổ||Mã|Tổ/Đội|
2|M011|Đoi1|ToA||M011|ToA|Chỉ có 1 M01* nên không thành đội 1

3|M021|Đoi2|ToB||M021|ToB|

4|M022|Đoi2|ToC||M022|ToC|

5|M031|Đoi3|ToD| ===>|M02|Đoi2|Có 2 (>1) M02* nên có đội 2
6|M041|Đoi4|ToE||M031|ToD|Chỉ có 1 M03* nên không thành đội 3
7|M042|Đoi4|ToF||M041|ToE|
8|M043|Đoi4|ToG||M042|ToF|
9|M051|Đoi5|ToH||M043|ToG|
10| | | | |M04|Đoi4|Có 3 (>1) M04* nên có đội 4
11| | | | |M051|ToH|Chỉ có 1 M05* nên không thành đội 5

Bài này có phần giống như bài điền STT của bạn phucfe trong topic Công thức số thứ tự ,
Lại có phần giống như bài của hoangdanh82vn về phần Trích lọc danh sách duy nhất từ các phần tử duy nhất

boyxin · 14/8/08

HYen17 đã viết:

Mã:

Option Explicit
[B]Sub ToHop()[/B]
1 Dim lRow As Long, Zw As Long
 Dim JwZ As Integer, Jj As Integer
3 Dim Rng As Range
 [e1] = [a1]:        [f1] = [C1] & "/" & [B1]
5 lRow = [A65500].End(xlUp).Row
 Range("E2:F" & lRow * 9).Clear
7 For Zw = 2 To lRow
   If Zw = 2 Then
9      [e2] = [a2]:      [f2] = [c2]
   Else
11      With Cells(Zw, 1)
         Jj = CInt(Mid(.Offset(-1), 2))
13         If Zw > 3 Then JwZ = CInt(Mid(.Offset(-2), 2))
         Set Rng = Range("E" & [e65500].End(xlUp).Row + 1)
15         If Jj \ 10 + 1 = CInt(Mid(.Value, 2)) \ 10 And _
            CInt(Mid(.Value, 2)) Mod 10 = 1 And _
            (.Row <> 3 And Jj - 1 = JwZ) Then
16            Rng = Mid(.Offset(-1), 1, Len(.Offset(-1)) - 1)
            Rng.Offset(, 1) = .Offset(-1, 1)
18            Rng.Resize(, 2).Interior.ColorIndex = 39
            Set Rng = Rng.Offset(1)
20         End If
         Rng = .Value:           Rng.Offset(, 1) = .Offset(, 2)
22      End With
   End If
24 Next Zw
[B]End Sub[/B]

Chạy đoạn code này em thấy có 2 vấn đề:

1. Nếu phần mã không sắp thứ tự, bị xáo trộn thì kết quả không như ý
VD: thay M051 thành M052; M061; M032; ...
2. Khi thêm dòng M052 thì cũng không có giá trị đội 5

Mong bác kiểm tra lại giúp

SA_DQ · 14/8/08

boyxin đã viết:
em thấy có 2 vấn đề:
1. Nếu phần mã không sắp thứ tự, bị xáo trộn thì kết quả không như ýVD: thay M051 thành M052; M061; M032; ...
2. Khi thêm dòng M052 thì cũng không có giá trị đội 5
Mong bác kiểm tra lại giúp

Chờ ý kiến của tác gia Topic vậy(!) Mình nghĩ rằng danh sách đã phải được sắp xếp sẵn.
Câu (2) - Sẽ kiểm chứng sau!

Nhờ MOD/SMOD ngang qua đây xóa giúp bài này, xin cảm ơn nhiều!

chibi · 15/8/08

HYen17 đã viết:
Theo mình, khi bạn làm việc trong vòng lặp với đối tượng Ranges, thì nên dùng thuộc tính Offset(R,C) sẽ dễ nhìn hơn;
Hơn nữa, nếu bạn dùng cú pháp With . . . End With sẽ thêm nhanh hơn;

PHP:

For i = 2 To eRow With Range("A" & i) .Offset(, 4) = .Value .Offset(,5) = .Offset(, 2).Value .Offset(,6) = .Offset(, 2).Value If Left(.Value, 3) = Left( .Offset( i - 1).Value, 3) And _ Left(.Value, 3) <> Left( .Offset( i + 1).Value, 3) Then iRow = iRow + 1 .Offset(, 4).Value = Left(.Value, 3) .Offset(, 5).Value = .Offset( , 1).Value End If iRow = iRow + 1 End With Next

Chúc vui vẻ!

Đoạn code không cho kết quả mong muốn.

SA_DQ · 15/8/08

Trước khi chạy mảco, mình đã thêm mấy cột rồi đó!

chibi đã viết:
Đoạn code không cho kết quả mong muốn.

Hình ảnh kết quả sau khi chạy macro TongHop

tucontruc · 15/8/08

Bạn xem đã được chưa?

Lấy danh sách hỗn hợp từ DS có sẵn

diemvuongvathuongde

Thành viên chính thức

File đính kèm

LikeIt

Thành viên tiêu biểu

SA_DQ

/(hông là gì!

diemvuongvathuongde

Thành viên chính thức

sealand

Thành viên gạo cội

ndu96081631

Huyền thoại GPE

SA_DQ

/(hông là gì!

chibi

Thành viên tích cực

SA_DQ

/(hông là gì!

boyxin

Members actively

boyxin

Members actively

SA_DQ

/(hông là gì!

chibi

Thành viên tích cực

SA_DQ

/(hông là gì!

tucontruc

Thành viên mới

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

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

Đếm ngược thời gian