Lọc dữ liệu theo điều kiện? (1 người xem)

  • Thread starter Thread starter pmhoang
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

pmhoang

Thành viên thường trực
Tham gia
4/7/08
Bài viết
269
Được thích
83
Mình mới học VBA, Minh lập trình File này để sử dụng, mà mấy hôm này cứ làm đi làm lại mà không được ở bước lọc dữ liệu (FilterData). Mình post file len GPE mong anh em giúp đở với. Thanhk GPE

Yêu Cầu Lọc Theo điều kiện
Xóa hết các hàng, chỉ để lại những hàng thỏa điều kiện bên dưới
Lấy VD là Beam B1
1. Ở đầu Loc lấy hàng dữ liệu có M3 giá trị nhỏ nhất (hàng 7 có M3= -6.607)
2. Ở giữa Loc lấy hàng dữ liệu có M3 giá trị lớn nhất (hàng 28 hoặc 29 cũng được có M3= 3.525)
3. Ở cuối Loc lấy hàng dữ liệu có M3 giá trĩ nhỏ nhất (hàng 53 có M3= -6.684)


File gởi kèm ở bên dưới, hoặc theo link sau:
http://www.megaupload.com/?d=4NVSWINB

Mình mới học VBA, Minh lập trình File này để sử dụng, mà mấy hôm này cứ làm đi làm lại mà không được ở bước lọc dữ liệu (FilterData). Mình post file len GPE mong anh em giúp đở với. Thanhk GPE

Yêu Cầu Lọc Theo điều kiện
Xóa hết các hàng, chỉ để lại những hàng thỏa điều kiện bên dưới
Lấy VD là Beam B1
Ở đầu Loc lấy hàng dữ liệu có M3 giá trị nhỏ nhất (hàng 7 có M3= -6.607)
Ở giữa Loc lấy hàng dữ liệu có M3 giá trị lớn nhất (hàng 28 hoặc 29 cũng được có M3= 3.525)
Ở cuối Loc lấy hàng dữ liệu có M3 giá trĩ nhỏ nhất (hàng 53 có M3= -6.684)
Lấy hàng có V2 nhỏ nhất (hàng 7 có V2= -5.94)
Lấy hàng có V2 lớn nhất (hàng 52 có V2= 6.09)


HTML:
Yêu Cầu Lọc Theo điều kiện
Xóa hết các hàng, chỉ để lại những hàng thỏa điều kiện bên dưới
Lấy VD là Beam B1
1. Ở Loc đầu, lấy hàng dữ liệu có M3 giá trị nhỏ nhất (hàng 7 có M3= -6.607)
2. Ở Loc giữa, lấy hàng dữ liệu có M3 giá trị lớn nhất (hàng 28 hoặc 29 cũng được có M3= 3.525)
3. Ở Loc cuối, lấy hàng dữ liệu có M3 giá trĩ nhỏ nhất (hàng 53 có M3= -6.684)
(chú ý: Loc ở đây không phải là lọc mà là 1 ký hiệu đại diện, nghĩa của nó là mặt cắt)

Mình có ghi chú bảng tính trong file như sau:
Cột Loc (Cột có tên Lốc là cột D) là vị trí mặt cắt của Beam, vị trí cắt này không phải lúc nào cũng tăng lên theo bội số 0.5, mà là 1 số nào đó
VD Loc (Loc ở đây được hiểu là mặt cắt) của B1 là: 0 0.5 1 1.5 2 … 6 (đầu Loc la 0 va cuối Loc là 6)
có nghĩa là đối với Beam B1 thì ta có các Loc (mặt cắt) đi từ đầu bên này đến đầu bên kia, Ví dụ như ta có B1 là cây thước gạch dài 6 (cm). (Loc di từ 0 đến 6)
0 , 0.5, 1 , 1.5, 2, 2.5, 3 , 3.5, 4, 4.5, 5, 5.5, 6 đó là các khoảng cách mà ta dùng dao chặt cây thước gạch ấy ra (mặt cắt)

Mỗi lần cắt (tương ứng vói 1 vết đứt - tương ướng với 1 hàng số liệu trên bảng tính) cho ra M3 tương ứng
Nếu cây thước gạch đó chia là 4 phần, 6/4=1.5 cm, thì phần 1/4 đầu tiên Loc (từ >= 0 đến <1.5) thì gọi là phần Loc đầu tiên
1/4 đoạn cuối (từ > 4.5 đến <=6) gọi là Loc cuối. Còn lại 2/4 ở giữa gọi là Loc giữa.
Cái đó là cái khó nhất vì đối với mỗi loại Beam ta phải phân đoạn cho nó để lấy số liệu.
Hi vong cac bạn sẽ hiểu và giúp mình. thanks

Yêu cầu của mình là xóa hết hàng và để lại các hàng thỏa điều kiện
VD cụ thể là hàng số liệu tương ứng với hàng 7,28 hoăc 29, 53, 52 cho Beam B1
còn B2, B3, B5, B6 là tương tự như vậy mà để lại.

Có nghĩa là với Beam B1 cụ thể là xóa hết còn lại 3 hàng,
hàng 1 là hàng số 7 (khi chưa xóa)
hàng 2 là hàng 28 hoăc 29 (khi chưa xóa)
hàng 3 là hàng 53 (khi chưa xóa)

(Nhưng ô mà mình tô màu xanh va đậm là nhưng ô thỏa điều kiện và ta giữa lại hàng chứa nhưng o đó. còn lại là xóa)
Tương tự Beam B2 cũng còn lại 3 hàng.
Mình đã làm bằng tay đối với Beam B1, B2, B3, Và tô đậm màu xanh các ô thỏa mãn điều kiện ở Beam B4 có ghi chú từng trường hợp. Có lẽ anh ThuNghi giờ sẽ hiểu ý mình. Và mong anh ThuNghi giúp em với. ( chú ý đùng bấm nút ClearData, sẽ xóa hết nhưng ghi chú đó của mình)

Nói thì nhiều cho các bạn dẻ hình dung, chứ tốm lại có 1 câu 1 thôi.
Làm sao cho mỗi phần tử Beam chỉ để lại 3 dòng, có giá trị tuyệt đối lớn nhất ở 3 vị trị: Đầu , Giưu và Cuối.

Anh chi em GPE với!

Làm sao cho mỗi phần tử Beam chỉ để lại 3 dòng, có giá trị tuyệt đối lớn nhất ở 3 vị trị: Đầu , Giưu và Cuối. còn lại là xóa hết.
file gởi kềm ở #3

Yêu Cầu Lọc Theo điều kiện( file gởi kềm trong #1)
Xóa hết các hàng, chỉ để lại những hàng thỏa điều kiện bên dưới
Lấy VD là Beam B1
1. Ở Loc đầu, lấy hàng dữ liệu có M3 giá trị nhỏ nhất (hàng 7 có M3= -6.607)
2. Ở Loc giữa, lấy hàng dữ liệu có M3 giá trị lớn nhất (hàng 28 hoặc 29 cũng được có M3= 3.525)
3. Ở Loc cuối, lấy hàng dữ liệu có M3 giá trĩ nhỏ nhất (hàng 53 có M3= -6.684)
 

File đính kèm

Với Beam B1, M3 sẽ tăng dần -> X -> gảim dần
-6607, -3791, -3745,...,0.621, tăng 1.666: cái này tính min trong khỏan thì OK nhưng mà dãy số này lại.
Hình như dãy số trên còn phải có quy luật gì, -4879 tăng đến gần 3525 rồi giảm 3235 và ...-6607, -3791, -3745,...,0.621, tăng 1.666. Khó quá.
Số lớn nhất thì OK.
Hướng của tôi làm là xác định range mà beam =B1 => MyRng => số lớn 1.
Xác định MyRng trên khi nào mà MyRng(n) > MyRng(n+1) và MyRng(n) < MyRng(n-1) thì xác định lại NewRng => số min. Nhưng mà dãy số trên có 2 lần tăng giảm nên khó quá.
 
Upvote 0
Với Beam B1, M3 sẽ tăng dần -> X -> gảim dần
-6607, -3791, -3745,...,0.621, tăng 1.666: cái này tính min trong khỏan thì OK nhưng mà dãy số này lại.
Hình như dãy số trên còn phải có quy luật gì, -4879 tăng đến gần 3525 rồi giảm 3235 và ...-6607, -3791, -3745,...,0.621, tăng 1.666. Khó quá.
Số lớn nhất thì OK.
Hướng của tôi làm là xác định range mà beam =B1 => MyRng => số lớn 1.
Xác định MyRng trên khi nào mà MyRng(n) > MyRng(n+1) và MyRng(n) < MyRng(n-1) thì xác định lại NewRng => số min. Nhưng mà dãy số trên có 2 lần tăng giảm nên khó quá.
1. Quy luật của dãy số, bạn có thể qua sheet Etabs sẽ thấy rõ hơn, Nó sắp xếp theo Cột C (Load) ENVEMAX trước xong rồi mới tới ENVEMIN, trên mỗi ENVEMAX hoac ENVEMIN thì M3 thay đổi giá trị theo đường cong, từ nhỏ đến lớn rồi nhỏ lại. trên mỗi ENVEMAX hoặc ENVEMIN thì LOC cũng thay đổi từ 0 đến 6.

Ở sheet Beam mình đã sắp xếp (Sort trong VBA - Bạn có thể xóa phần Sort trong VBA) theo Tên Beam và Loc, cho nên nó sắp xếp theo Lóc từ 0 đến 6. như thế M3 có biến đổi hơi lên xuống 1 tí, nhưng vẫn đảm bảo rằng M3 đi theo đường cong .Tăng đến 1 giá trị nào đó rồi giảm dần.

2. Ý kiến về VBA của bạn. Mình chưa hiểu ý bạn lắm. chỉ hình dung sơ sơ. ban có thể cụ thể hóa bằng VBA trong file dc ko??? vì mình mới học VBA nên chậm hiểu.
nhưng từ ý nghĩa của bạn mình lại nghĩ ra rằng
Bạn chú ý nhìn vào biểu đò thay đổi của M3 mình có vẽ hình minh họa trong file (mình mới cập nhật lại 2 file mới, có hình minh họa)
Ban đầu xác định M3 lớn nhất (nó lúc nào cũng nằm ở giữa của B1), khi đó ta có thể tách ra làm 2 vùng,
Vùng1 trên M3 max và vùng2 dưới M3 max
tiếp tục lấy min vùng 1 sẽ được M3 min ở trên.
lấy min vùng 2 sẽ dược M3 min ở dưới.
làm xong với B1 tiếp tục chuyển xuống B2 và làm tiếp... hướng đi thì có thể hình dung như vậy, nhưng ko biết có thực hiện được không?
Mong các bạn gốp ý. cảm ơn bạn ThuNghi nhiều, mong bạn giúp mình với.
 
Lần chỉnh sửa cuối:
Upvote 0
HTML:
Yêu Cầu Lọc Theo điều kiện
Xóa hết các hàng, chỉ để lại những hàng thỏa điều kiện bên dưới
Lấy VD là Beam B1
1. Ở Loc đầu, lấy hàng dữ liệu có M3 giá trị nhỏ nhất (hàng 7 có M3= -6.607)
2. Ở Loc giữa, lấy hàng dữ liệu có M3 giá trị lớn nhất (hàng 28 hoặc 29 cũng được có M3= 3.525)
3. Ở Loc cuối, lấy hàng dữ liệu có M3 giá trĩ nhỏ nhất (hàng 53 có M3= -6.684)

Mình có ghi chú bảng tính trong file như sau:
Cột Loc là vị trí mặt cắt của Beam, vị trí cắt này không phải lúc nào cũng tăng lên theo bội số 0.5, mà là 1 số nào đó
VD Loc (Loc ở đây được hiểu là mặt cắt) của B1 là: 0 0.5 1 1.5 2 … 6 (đầu Loc la 0 va cuối Loc là 6)
có nghĩa là đối với Beam B1 thì ta có các Loc (mặt cắt) đi từ đầu bên này đến đầu bên kia, Ví dụ như ta có B1 là cây thước gạch dài 6 (cm). (Loc di từ 0 đến 6)
0 , 0.5, 1 , 1.5, 2, 2.5, 3 , 3.5, 4, 4.5, 5, 5.5, 6 đó là các khoảng cách mà ta dùng dao chặt cây thước gạch ấy ra (mặt cắt)

Mỗi lần cắt (tương ứng vói 1 vết đứt - tương ướng với 1 hàng số liệu trên bảng tính) cho ra M3 tương ứng
Nếu cây thước gạch đó chia là 4 phần, 6/4=1.5 cm, thì phần 1/4 đầu tiên Loc (từ >= 0 đến <1.5) thì gọi là phần Loc đầu tiên
1/4 đoạn cuối (từ > 4.5 đến <=6) gọi là Loc cuối. Còn lại 2/4 ở giữa gọi là Loc giữa.
Cái đó là cái khó nhất vì đối với mỗi loại Beam ta phải phân đoạn cho nó để lấy số liệu.
Hi vong cac bạn sẽ hiểu và giúp mình. thanks

Yêu cầu của mình là xóa hết hàng và để lại các hàng thỏa điều kiện
VD cụ thể là hàng số liệu tương ứng với hàng 7,28 hoăc 29, 53, 52 cho Beam B1
còn B2, B3, B5, B6 là tương tự như vậy mà để lại.

Có nghĩa là với Beam B1 cụ thể là xóa hết còn lại 3 hàng,
hàng 1 là hàng số 7 (khi chưa xóa)
hàng 2 là hàng 28 hoăc 29 (khi chưa xóa)
hàng 3 là hàng 53 (khi chưa xóa)

(Nhưng ô mà mình tô màu xanh va đậm là nhưng ô thỏa điều kiện và ta giữa lại hàng chứa nhưng o đó. còn lại là xóa)
Tương tự Beam B2 cũng còn lại 3 hàng.
Mình đã làm bằng tay đối với Beam B1, B2, B3, Và tô đậm màu xanh các ô thỏa mãn điều kiện ở Beam B4 có ghi chú từng trường hợp. Có lẽ anh ThuNghi giờ sẽ hiểu ý mình. Và mong anh ThuNghi giúp em với. ( chú ý đùng bấm nút ClearData, sẽ xóa hết nhưng ghi chú đó của mình)

Nói thì nhiều cho các bạn dẻ hình dung, chứ tốm lại có 1 câu 1 thôi.
Làm sao cho mỗi phần tử Beam chỉ để lại 3 dòng, có giá trị tuyệt đối lớn nhất ở 3 vị trị: Đầu , Giưu và Cuối.

Bạn xem đã đúng ý của bạn chưa?
  1. drop-Down List J2: lựa chọn Beam
  2. drop-Down List K2: lựa chọn Cột V hoặc M lấy làm cơ sở để lọc
Bảng lọc sẽ lấy những dòng có giá trị
  1. Nhỏ nhất ở đầu lọc
  2. Lớn nhất ở giữa lọc
  3. Nhỏ nhất ở cuối lọc
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Bạn xem đã đúng ý của bạn chưa?
  1. drop-Down List J2: lựa chọn Beam
  2. drop-Down List K2: lựa chọn Cột V hoặc M lấy làm cơ sở để lọc
Bảng lọc sẽ lấy những dòng có giá trị
  1. Nhỏ nhất ở đầu lọc
  2. Lớn nhất ở giữa lọc
  3. Nhỏ nhất ở cuối lọc
1. Thanks Boyxin rất nhiều. Bạn không dùng VB mà làm ra như vậy quả thật là giỏi. Bạn đã hiểu đúng yêu cầu của mình rồi đó. Nhưng rất tiết 1 siếu là kết quả có lúc đúng lúc sai VD như Beam B4 cho ket quả là -8.003 , 4.522, -4.807. số thứ 3 là -4.807 nhưng thực tế nhìn vào bảng số liệu số này là: -8.343 (min nhất ở cuối Loc).
2. Ô lựa chọn J2 là các lựa chọn cố định vd B1, B2, B3...B6, Nhưng thực tế có lúc dữ liệu của ta nhiều hơn B6...mà là B7, B8... thì nó không cập nhật được.
Nhưng dù sao đây cung là 1 phương án hay, mình sẽ nguyên cứu nó.
3. Bảng này là bảng nhỏ trích số liệu ra từ dữ liệu. Cho nên cùng 1 lúc chỉ có thể chọn 1 loại Beam.
4. Mình muốn trong bảng dữ liệu ta gôm các Beam lại, bằng cách xóa đi các hàng số liệu thừa, chỉ để lại mỗi loại Beam là 3 dòng (thỏa điều kiện).
5. Nếu mà làm điều này thật sự quá khó. Thì mình chỉ xin bạn cách giúp mình tô đậm 3 ô thỏa điều kiện của 1 Beam để mình dể nhận ra nó.

Thank Boyxin
 
Upvote 0
Vậy hiểu thế này đúng không:
M3 min trong khỏan 1.5>loc >=0 (có thể là sẽ có 2 khỏan) => lọc đầu
M3 min trong khỏan 6>=loc >4.5 (có thể là sẽ có 2 khỏan) => lọc cuối
Lọc giữa là max(M3).
Vậy ta xét từng M3 trong các khỏan loc 1.5>loc >=0 để tìm lọc đầu và tương tự => lọc cuối.
 
Upvote 0
Vậy hiểu thế này đúng không:
M3 min trong khỏan 1.5>loc >=0 (có thể là sẽ có 2 khỏan) => lọc đầu
M3 min trong khỏan 6>=loc >4.5 (có thể là sẽ có 2 khỏan) => lọc cuối
Lọc giữa là max(M3).
Vậy ta xét từng M3 trong các khỏan loc 1.5>loc >=0 để tìm lọc đầu và tương tự => lọc cuối.

Đúng rồi đó.Rất chính xác. Nếu bạn làm đươc như vậy thì quá là OK. còn nếu khó quá thì mình cũng chấp nhận rui ro. la phải làm theo cách đơn giản hơn như gợi ý ở dưới.
Gợi ý thêm cho bạn dẻ hiểu.
Thường thường thì Loc đầu tiên (VD Beam B4, Loc đầu tiên =0, có 2 hàng) sẽ có 1 hàng chứa M3 min thứ 1
Loc cuối (VD Beam B4, Loc cuối = 6, co 2 hàng) sẽ có 1 hàng chứa M3 min thứ 2
Còn lại thì ở Loc giữa ta lấy giá trị M3 max

Lấy VD cho Beam B4
Có thể VB mình làm việc theo nguyên tắc chỉ cần Xêt Loc giữa (1 vùng Loc ở giữa)=> M3 max =4.522
Chỉ xét 1 Loc đầu = min(cột Loc/B4)=0 (2 hàng chọn 1 hàng có M3 min)=>M3 min1 = -8.003
Chỉ xét 1 Loc cuối = max(cột Loc/B4)=6 (2 hàng chọn 1 hàng có M3 min)=> M3 min2 =-8.343
Chỉ cần tô đậm Ô M3 thỏa mãn điều kiện là Ok rồi.
 
Lần chỉnh sửa cuối:
Upvote 0
Đúng rồi đó.Rất chính xác.
Gợi ý thêm cho bạn dẻ hiểu.
Thường thường thì Loc đầu tiên (VD Beam B1, Loc đầu tiên =0, có 2 hàng) sẽ có 1 hàng chứa M3 min thứ 1
Loc cuối (VD Beam B1, Loc cuối = 6, co 2 hàng) sẽ có 1 hàng chứa M3 min thứ 2
Còn lại thì ở Loc giữa ta lấy giá trị M3 max

Có thể VB mình làm việc theo nguyên tắc chỉ cần Xêt Loc giữa (1 vùng Loc ở giữa)=> M3 max
Chỉ xét 1 Loc đầu (2 hàng chọn 1 hàng)=>M3 min1
Chỉ xét 1 Loc cuối (2 hàng chọn 1 hàng)=> M3 min2
Chỉ cần tô đậm Ô thỏa mãn điều kiện là Ok rồi.
Vậy thì hướng làm như sau, bạn xem có OK?
- Dùng Advance Filter theo Beam = B1... và 1.5>loc >=0 => Những M3 của lọc đầu, xét min => M3
- Tương tự => M3 lọc cuối.
- Lọc giưa là max(M3) với DK Beam=B1,...
Để tôi làm thử.
 
Upvote 0
Vậy thì hướng làm như sau, bạn xem có OK?
- Dùng Advance Filter theo Beam = B1... và 1.5>loc >=0 => Những M3 của lọc đầu, xét min => M3
- Tương tự => M3 lọc cuối.
- Lọc giưa là max(M3) với DK Beam=B1,...
Để tôi làm thử.
Dùng Advance Filter cũng được, nếu làm vậy thì sau đó mình phải dùng VB xóa di nhưng hàng bị Filter ẩn đi. Cái khó nhất của Advance Filter là 0<=Loc<1.5 điều kiện này không cố định. VD ở B4 Min(Loc)=0, Max(Loc)=6
còn ở B5 Min(Loc)=0, Max(Loc)=3
Cho nên đối với từng loại Beam phải lấy chính xác làMin(Loc) < Loc <= Max(Loc)/4


? Mình có hướng làm như ở Bài #6 nhừng mà tối hôm qua thức tới 2 h mà cũng chỉ làm cho Tô đậm M3 max ở giữa được thôi. còn M3 min1 và M3 min2 thì vẫn bó tay.? anh e nào theo hướng này xin giúp với.

Anh ThuNghi có thể chát YM truc tiep voi em được không? nick em la pm.hoang (hoăc nhấp vào link ơ dưới)
 
Lần chỉnh sửa cuối:
Upvote 0
1. Thanks Boyxin rất nhiều. Bạn không dùng VB mà làm ra như vậy quả thật là giỏi. Bạn đã hiểu đúng yêu cầu của mình rồi đó. Nhưng rất tiết 1 siếu là kết quả có lúc đúng lúc sai VD như Beam B4 cho ket quả là -8.003 , 4.522, -4.807. số thứ 3 là -4.807 nhưng thực tế nhìn vào bảng số liệu số này là: -8.343 (min nhất ở cuối Loc).
2. Ô lựa chọn J2 là các lựa chọn cố định vd B1, B2, B3...B6, Nhưng thực tế có lúc dữ liệu của ta nhiều hơn B6...mà là B7, B8... thì nó không cập nhật được.
Nhưng dù sao đây cung là 1 phương án hay, mình sẽ nguyên cứu nó.
3. Bảng này là bảng nhỏ trích số liệu ra từ dữ liệu. Cho nên cùng 1 lúc chỉ có thể chọn 1 loại Beam.
4. Mình muốn trong bảng dữ liệu ta gôm các Beam lại, bằng cách xóa đi các hàng số liệu thừa, chỉ để lại mỗi loại Beam là 3 dòng (thỏa điều kiện).
5. Nếu mà làm điều này thật sự quá khó. Thì mình chỉ xin bạn cách giúp mình tô đậm 3 ô thỏa điều kiện của 1 Beam để mình dể nhận ra nó.

Thank Boyxin





Có cách dùng tạm: kết hợp VBA với công thức <=> tự động cập nhật Beam theo data
rar.gif
GPEboyxin LOC full.rar
Bạn kiểm tra lại xem còn chỗ nào sai không nhé
 
Lần chỉnh sửa cuối:
Upvote 0
Có cách dùng tạm: kết hợp VBA với công thức <=> tự động cập nhật Beam theo data

Bạn kiểm tra lại xem còn chỗ nào sai không nhé

Minh đang kiểm tra. Thấy Ok lắm. nhưng mấy cái vụ định nghi công thức trong Name Define. Mình chưa hiểu lắm. Bạn có thể chuyển thể hết nó bằng VB được ko? vì khi share cho người khác có thể sẽ bị người ta phá lung lung, hư hết công thức.

Minh đã kiểm ra vài lỗi. post file lên cho anh em xem trước đã. giờ buồn ngủ quá. nằm 30 phút sau mình sẽ nói cái lỗi cụ thể. anh em thông cảm
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Minh đang kiểm tra. Thấy Ok lắm. nhưng mấy cái vụ định nghi công thức trong Name Define. Mình chưa hiểu lắm. Bạn có thể chuyển thể hết nó bằng VB được ko? vì khi share cho người khác có thể sẽ bị người ta phá lung lung, hư hết công thức.

Có 1 chổ bị lỗi. chờ mình tí...mình sẽ send file lên.

đã sửa lại 1 vài lỗi mới phát hiện
rar.gif
GPEboyxin LOC full.rar

Trước khi lọc Beam cần kiểm tra Etabs đã sắp thứ tự Beam chưa? (nếu chưa thì sort lại)

Công thức không sợ hư (thấy hư thì Lọc lại là OKIE)

Có thể thêm sự kiện Unprotect trước khi lọc, protect sau khi lọc
 
Lần chỉnh sửa cuối:
Upvote 0
đã sửa lại 1 vài lỗi mới phát hiện

Trước khi lọc Beam cần kiểm tra Etabs đã sắp thứ tự Beam chưa? (nếu chưa thì sort lại)

Công thức không sợ hư (thấy hư thì Lọc lại là OKIE)

Có thể thêm sự kiện Unprotect trước khi lọc, protect sau khi lọc

1. Etabs là phần dữ liệu ban đầu Mình muốn nó nguyên vẹn nên mình đã cập nhật dữ liệu qua Sheet Beam để sử lý. Ở Sheet Beam mình đã Sort theo Beam và Loc rồi.
2. Các lỗi xẫy ra:(File gởi kèm ở bài #14)
a- Etabs của mình tính lúc này gồm các Beam B6, B7, B9, B12 thì ở Sheet Loc xẫy ra tình trạng B1, B2, B3.... bị #N/A (Đúng ra thì các B1, B2, B3 này không tồn tại trong Data)
b- Khi làm tới nhiều hơn B12, VD làm tới B12, B13, B14. và quay về làm với số Beam ít hơn VD B12 thì số B13, B14 kia vẫn còn tồn tại trong Sheet Loc (cái này có thể thêm lệnh clearn trong VB là OK)
c- Story (Tầng), lúc đầu ta làm với tầng Trệt (ký hiệu TR), sau đó ta làm với lầu 1 (ký hiệu LAU1) - > thì Sheet Loc lại vẫn giữ nguyên là Story là TR.
3. Mình nghĩ: chỉ cần nhận dạng là 1 loại Beam và làm việc tìm kiếm trên tên Beam đó. không phân biệt tên Beam bắt đầu bằng gì. khi đó hình như chỉ có thể VB mới Run được. còn dùng công thức thì nó phải có 1 nguyên tắc, nên rất khó. File của bạn làm rất đúng rất Ok, nếu ko có các lỗi đó thì xêm như hoàn chỉnh rồi. Cảm ơn Boyxin nhiều. Mong các bạn GPE cùng giúp mình với.
 
Lần chỉnh sửa cuối:
Upvote 0
1. Etabs là phần dữ liệu ban đầu Mình muốn nó nguyên vẹn nên mình đã cập nhật dữ liệu qua Sheet Beam để sử lý. Ở Sheet Beam mình đã Sort theo Beam và Loc rồi.
2. Các lỗi xẫy ra:(File gởi kèm ở bài #14)
a- Etabs của mình tính lúc này gồm các Beam B6, B7, B9, B12 thì ở Sheet Loc xẫy ra tình trạng B1, B2, B3.... bị #N/A (Đúng ra thì các B1, B2, B3 này không tồn tại trong Data)
b- Khi làm tới nhiều hơn B12, VD làm tới B12, B13, B14. và quay về làm với số Beam ít hơn VD B12 thì số B13, B14 kia vẫn còn tồn tại trong Sheet Loc (cái này có thể thêm lệnh clearn trong VB là OK)
c- Story (Tầng), lúc đầu ta làm với tầng Trệt (ký hiệu TR), sau đó ta làm với lầu 1 (ký hiệu LAU1) - > thì Sheet Loc lại vẫn giữ nguyên là Story là TR.
3. Mình nghĩ: chỉ cần nhận dạng là 1 loại Beam và làm việc tìm kiếm trên tên Beam đó. không phân biệt tên Beam bắt đầu bằng gì. khi đó hình như chỉ có thể VB mới Run được. còn dùng công thức thì nó phải có 1 nguyên tắc, nên rất khó. File của bạn làm rất đúng rất Ok, nếu ko có các lỗi đó thì xêm như hoàn chỉnh rồi. Cảm ơn Boyxin nhiều. Mong các bạn GPE cùng giúp mình với.
Bạn xem thử file tôi làm thử, yêu cầu là sh Etabs đã lọc theo Beam rồi.
Code chưa rút gọn lại còn nhiều biến quá, nếu OK sẽ rút gọn sau. Mới chỉ làm từ B1->B6.
 

File đính kèm

Upvote 0
Bạn xem thử file tôi làm thử, yêu cầu là sh Etabs đã lọc theo Beam rồi.
Code chưa rút gọn lại còn nhiều biến quá, nếu OK sẽ rút gọn sau. Mới chỉ làm từ B1->B6.

Cảm ơn ThuNghi rất nhiều. File của bạn chạy mình rất ưng ý (theo dúng ý mình đó), nhưng còn gặp 1 số lỗi sai 1 chút.
VD B1 cho ra 3 hàng có M3 là -6.607, 3.525, -3.791 (ThuNghi)
Thực tế là -6.607, 3.525 -6.684 (Boyxin)
Mình mới kiểm tra tới đó. Mình sẽ xem tiếp, Cảm ơn bạn nhiều.

Minh nghĩ VB của mình nên làm theo hướng này sẽ đơn giản hơn (nhưng trình độ VB minh chưa đủ làm, mình làm 1 lúc là nó chạy thăm thẳm không có điểm đùng)
PHP:
Sub LocM3max() 'Mình chỉ tìm ra M3max còn M3min1 , M3 min2 thì làm chưa duoc
  n = 6   'n: hang
  Cells(n, "F").Select 'Minh hoa
  Do Until Cells(n, "B") = ""
    somax = Cells(n, "F").Value
    Cells(n, "F").Font.Bold = True
    n_dauBeam = n
    Do While Cells(n, "B").Value = Cells(n + 1, "B").Value
      so1 = Cells(n, "F").Value
      If so1 > somax Then
        somax = so1
        Range(Cells(n_dauBeam, "F"), Cells(n - 1, "F")).Font.Bold = False
        Cells(n, "F").Font.Bold = True
      End If
      n = n + 1
      Cells(n, "F").Select  'Minh hoa
    Loop  ''Mình chưa tìm ra cách nhảy qua Beam khac, nen code nay chi chay tren B1 thoi
  Loop
End Sub
1- Với cách này thì mình chỉ Tô đậm được M3 máx của 1 loại Beam (và xuất ra giá trị của Row có M3 max)
2- M3 min1 mình nghĩ là chọn Vùng1 từ trên Row có M3max đi lên đến hàng có Loc(min) rồi diệt qua từng Cell xem giá trí trị nào nhỏ nhất sẽ lấy là M3min1, khi tìm được ta tô đậm chử lên.
3- M3 min2 mình nghĩ là chọn Vùng2 từ dưới Row có M3max đi xuống đến hàng có Loc(max) rồi diệt qua từng Cell xem giá trí trị nào nhỏ nhất sẽ lấy là M3min2, khi tìm được ta to đậm chử lên.
=> Kết quả là Beam B1 ta có 3 Cell ở cột F được tô đậm theo điều kiện lọc ở trên
4- Bước tiếp theo chuyển xuống Beam ở dưới, không phân biệt B2, hay B3, mà chỉ phân biệt bằng Cells(n,"B").value <> Cells(n+1,"B").value thì khi đó cho VB nhận biết là đã chuyển sang 1 Beam mới có tên là Cells(n+1,"B").value
- Tiếp tục lập lại các bước 1, 2, 3 ta được 1 bảng số liệu mà mỗi loại Beam sẽ có 3 Cells(n,"F").font.bold=true
- Tiếp tục dùng đọng Code này để xóa các hàng không tô đậm
PHP:
'Delete Data not Bold da duoc tu dong chon truoc do
Sub DeleteData()
  n = 6
  Cells(n, "F").Select
  Do Until Selection.Value = ""
    If Selection.Font.Bold Then
      n = n + 1
      Cells(n, "F").Select
    Else
      Rows(n).Delete
    End If
  Loop
End Sub
=> ra kết quả là 1 Beam chỉ để lại 3 hàng (3 hàng chứa ô được tô đậm)
Không biết hướng đi của mình có thực hiện được không? ban xêm thử nhé. vì nếu làm được thì đây là 1 đoạn Code rất Ok cho mọi tình huống, dù Beam đó tên gì không quan trọng, dù Story gì cũng chẳn sao. Code này có thể chạy được không cần các điều kiện sắp xếp.
Tối hôm qua mình thức đến 2giờ thế mà cũng chưa chuyển được nguyên tắc làm việc đó của code thành hiện thực. Mong cac bạn giúp mình
 
Lần chỉnh sửa cuối:
Upvote 0
Cho nên đối với từng loại Beam phải lấy chính xác là
Lọc đầu:
Min(Loc) < Loc <= Max(Loc)/4
Vậy lọc cuối
Lọc cuối:
Max(Loc)/4*3 < Loc <= Max(Loc)
Vậy
<= hay <
Nếu vậy bạn vào code sửa lại dòng
.Range("R2") = "<" & maxLoc 'Phan nay khac tren
thành
.Range("R2") = "<=" & maxLoc 'Phan nay khac tren
Là OK
Còn vấn để Beam và Story thì nên có 1 danh mục
Beam và Story để duyệt
từng Beam. Vấn đề này không khó.

Code sửa:
PHP:
Option Explicit
Sub LayKQ()
Dim i As Long, DongDau As Long, DongCuoi As Long, SoDong As Long
Dim VTmin As Long, iMinM As Double, VTmax As Long, iMaxM As Double
Dim eRow As Long, endR As Long, maxLoc As Double, FLoc As Double, ELoc As Double
Dim Data As Range, LocRng As Range, Beam As Range, mRng As Range, DataOK As Range
Dim iBeam As String
Dim WF As WorksheetFunction
Set WF = WorksheetFunction
Sheets("Beam").Select
Range("A6:I1000").ClearContents
With Application
       .DisplayAlerts = False:              .ScreenUpdating = False
       .Calculation = xlCalculationManual
End With
For i = 1 To 6
iBeam = "B" & i

    With Sheets("Etabs")
        eRow = .[A65000].End(xlUp).Row
        Set Beam = .Range("B2:B" & eRow)
            DongDau = WF.Match(iBeam, Beam, 0) + 1
            SoDong = WF.CountIf(Beam, iBeam)
            DongCuoi = DongDau + SoDong - 1
            Set LocRng = .Range("D" & DongDau & ":D" & DongCuoi)
            'Phan nay tim loc dau va loc cuoi'
            maxLoc = WF.Max(LocRng)
            FLoc = maxLoc / 4
            ELoc = maxLoc * 3 / 4
            '***Tim loc dau'
            Set Data = .Range("A1:J" & eRow)
            .Range("T2:Y10").ClearContents 'Xoa vung loc'
            'Gan thong so de loc'
            .Range("P2") = iBeam
            .Range("Q2").FormulaR1C1 = "="">=""&0"
            .Range("R2") = "<" & FLoc
            With Data
                .AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
                    "P1:R2"), CopyToRange:=.Range("T1:Y1"), Unique:=False
                ActiveWorkbook.Names("Criteria").Delete
                ActiveWorkbook.Names("Extract").Delete
            End With
            endR = .[Y65000].End(xlUp).Row
            Set mRng = .Range("Y2:Y" & endR)
            iMinM = WF.Min(mRng)
            VTmin = WF.Match(iMinM, mRng, 0) + 1
            endR = [A65000].End(xlUp).Row + 1
            Range("A" & endR & ":F" & endR).Value = .Range("T" & VTmin & ":Y" & VTmin).Value
            Range("A" & endR).Offset(, 8).Value = 1 'gan vao de sort'
            '***Tim loc cuoi'
            Set Data = .Range("A1:J" & eRow)
            .Range("T2:Y20").ClearContents 'Xoa vung loc
            'Gan thong so de loc'
            .Range("P2") = iBeam
            .Range("Q2") = ">=" & ELoc 'Phan nay khac tren'
            .Range("R2") = "<=" & maxLoc 'Phan nay khac tren
            '.Range("R2") = "<" & maxLoc 'Phan nay khac tren'
            With Data
                .AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
                    "P1:R2"), CopyToRange:=.Range("T1:Y1"), Unique:=False
                ActiveWorkbook.Names("Criteria").Delete
                ActiveWorkbook.Names("Extract").Delete
            End With
            endR = .[Y65000].End(xlUp).Row
            Set mRng = .Range("Y2:Y" & endR)
            iMinM = WF.Min(mRng)
            VTmin = WF.Match(iMinM, mRng, 0) + 1
            endR = [A65000].End(xlUp).Row + 1
            Range("A" & endR & ":F" & endR).Value = .Range("T" & VTmin & ":Y" & VTmin).Value
            Range("A" & endR).Offset(, 8).Value = 3 'gan vao de sort'
            '***Tim m lon nhat cua Beam'
            Set mRng = .Range("J" & DongDau & ":J" & DongCuoi)
            'Set DataOK = .Range("A" & DongDau & ":J" & DongCuoi)'
            iMaxM = WF.Max(mRng)
            VTmax = WF.Match(iMaxM, mRng, 0)
            'Gan GT max vao Sh Beam - Se rut gon'
            endR = [A65000].End(xlUp).Row + 1
            Range("A" & endR).Value = mRng(VTmax).Offset(, -9) 'gan vao A'
            Range("A" & endR).Offset(, 1).Value = mRng(VTmax).Offset(, -8) 'gan vao B'
            Range("A" & endR).Offset(, 2).Value = mRng(VTmax).Offset(, -7) 'gan vao C'
            Range("A" & endR).Offset(, 3).Value = mRng(VTmax).Offset(, -6) 'gan vao D'
            Range("A" & endR).Offset(, 4).Value = mRng(VTmax).Offset(, -4) 'gan vao E'
            Range("A" & endR).Offset(, 5).Value = mRng(VTmax).Offset(, 0) 'gan vao F'
            Range("A" & endR).Offset(, 8).Value = 2 'gan vao de sort'
        End With
    Next
endR = [A65000].End(xlUp).Row
Set Data = Range("A6:I" & endR)
With Data 'Sort lai'
    .Sort Key1:=Range("B6"), Order1:=xlAscending, Key2:=Range("I6") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
End With
Range("I6:I" & endR).ClearContents
'MsgBox endR
Set mRng = Nothing
Set LocRng = Nothing
Set Data = Nothing
With Application
       .DisplayAlerts = True
       .ScreenUpdating = True
       .Calculation = xlCalculationAutomatic
End With
End Sub
 
Upvote 0
1. Etabs là phần dữ liệu ban đầu Mình muốn nó nguyên vẹn nên mình đã cập nhật dữ liệu qua Sheet Beam để sử lý. Ở Sheet Beam mình đã Sort theo Beam và Loc rồi.
2. Các lỗi xẫy ra:(File gởi kèm ở bài #14)
a- Etabs của mình tính lúc này gồm các Beam B6, B7, B9, B12 thì ở Sheet Loc xẫy ra tình trạng B1, B2, B3.... bị #N/A (Đúng ra thì các B1, B2, B3 này không tồn tại trong Data)
b- Khi làm tới nhiều hơn B12, VD làm tới B12, B13, B14. và quay về làm với số Beam ít hơn VD B12 thì số B13, B14 kia vẫn còn tồn tại trong Sheet Loc (cái này có thể thêm lệnh clearn trong VB là OK)
c- Story (Tầng), lúc đầu ta làm với tầng Trệt (ký hiệu TR), sau đó ta làm với lầu 1 (ký hiệu LAU1) - > thì Sheet Loc lại vẫn giữ nguyên là Story là TR.
3. Mình nghĩ: chỉ cần nhận dạng là 1 loại Beam và làm việc tìm kiếm trên tên Beam đó. không phân biệt tên Beam bắt đầu bằng gì. khi đó hình như chỉ có thể VB mới Run được. còn dùng công thức thì nó phải có 1 nguyên tắc, nên rất khó. File của bạn làm rất đúng rất Ok, nếu ko có các lỗi đó thì xêm như hoàn chỉnh rồi. Cảm ơn Boyxin nhiều. Mong các bạn GPE cùng giúp mình với.

Bạn xem thế này đã được chưa? Có 1 yêu cầu duy nhất để lấy được kết quả đúng (là: các Beam trong Sheet Etabs được sort ) mà không ảnh hưởng đến cách ký hiệu Beam và Story

Toàn dùng Record Macro nên có thể còn bị dài dòng, code thừa ... bạn xem kết quả thế nào rồi sửa cho ngon lành nhé
(Mới tập tẹ VBA nên chưa thể đổi hết các công thức về dạng VBA thuần túy - Cái này phải nhờ các bác trên GPE giúp tiếp)

Tạm dùng cách củ chuối (xóa hết các công thức và các name trong Define) chỉ giữ lại kết quả
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Theo tôi hiểu mếu yêu cầu của bài này là: Theo Beam =iBeam=B1
MaxLoc =6
Lọc đầu: 0 < Loc dau <= maxloc/4 cụ thể là (0<X<=1.5) => M3 min trong khỏan lọc
Lọc giữa: maxloc/4 <LocGiua <= maxloc/4*3 cụ thể là (1.5<X<=4.5)=> M3 max trong khỏan lọc
Lọc cuối: maxloc/4*3 <LocGiua <= maxloc cụ thể là (4.5<X<=6) => M3 min trong khỏan lọc
Nếu như vậy thì tôi làm file sau. Có thể sửa lại số >= hay <= trong code nếu cụ thể vấn đề lọc trên. Sao thấy đáp án khác BoyXin nên chưa biết có đúng không. Sh Etabs không cần sort, khi xử lý sẽ sort sau đó sort lại. (Đúng ra nên dùng sheet Tmp thì hay hơn).
 

File đính kèm

Upvote 0
Theo tôi hiểu mếu yêu cầu của bài này là: Theo Beam =iBeam=B1
MaxLoc =6
Lọc đầu: 0 < Loc dau <= maxloc/4 cụ thể là (0<X<=1.5) => M3 min trong khỏan lọc
Lọc giữa: maxloc/4 <LocGiua <= maxloc/4*3 cụ thể là (1.5<X<=4.5)=> M3 max trong khỏan lọc
Lọc cuối: maxloc/4*3 <LocGiua <= maxloc cụ thể là (4.5<X<=6) => M3 min trong khỏan lọc
Nếu như vậy thì tôi làm file sau. Có thể sửa lại số >= hay <= trong code nếu cụ thể vấn đề lọc trên. Sao thấy đáp án khác BoyXin nên chưa biết có đúng không. Sh Etabs không cần sort, khi xử lý sẽ sort sau đó sort lại. (Đúng ra nên dùng sheet Tmp thì hay hơn).


Cách boyxin làm:
  1. AdvancedFilter Unique Beam rồi sort Beam
  2. Ghi mỗi Beam 3 giá trị
  3. Dựa vào Beam đã ghi, đặt name động xác định vùng của Beam
  4. Tìm vị trí đầu của Beam <=> Vt1
  5. Tìm vị trí đầu của Beam <=> Vt2
  6. Tìm MAX(Vt1:Vt2) => Vtmax
  7. Tìm MIN(Vt1:Vtmax) => Vtmin1
  8. Tìm MIN(Vtmax:Vt2) => Vtmin2
  9. Khi có đủ các Vtmin1, Vtmax, Vtmin2 thì ghi nốt các Cell còn lại của record
  10. Xóa Name, xóa công thưc chỉ giữ lại giá trị (có thể nói: giá trị chuẩn 100%)
Do không rành về VBA nên vẫn cảm thấy vòng vèo, lẫn lộn giữa công thức với VBA nên tốc độ bị hạn chế

Mong các bác dựa trên thuật toán trên, cải tiến giúp

PHP:
Option Explicit
Dim chu As String, Rng As Range
Dim So As Long, EndB As Long, EndR As Long, i As Long, j As Long
Sub GPEboyxin()
'Goi la gi nhi??? (1)'
With Application
       .DisplayAlerts = False
       .ScreenUpdating = False
       .Calculation = xlCalculationManual
End With
'Dat name cho cong thuc'
Sheets("Etabs").Select
    EndR = Range("B2").End(xlDown).Row
    Range("B2:B" & EndR).Name = "Beam"
ActiveWorkbook.Names.Add Name:="Vt1", RefersToR1C1:= _
        "=OFFSET(Etabs!R1C4,MATCH(boyxin!RC2,Beam,0),MATCH(boyxin!R2C3,boyxin!R1C5:R1C12,0))"
ActiveWorkbook.Names.Add Name:="Vt2", RefersToR1C1:= _
        "=OFFSET(Etabs!R1C4,MATCH(boyxin!RC2,Beam,0)+COUNTIF(Beam,boyxin!RC2)-1,MATCH(boyxin!R2C3,boyxin!R1C5:R1C12,0))"
ActiveWorkbook.Names.Add Name:="Vtmax", RefersToR1C1:= _
        "=OFFSET(Vt1,MATCH(MAX(Vt1:Vt2),Vt1:Vt2,0)-1,)"
ActiveWorkbook.Names.Add Name:="Vtmin1", RefersToR1C1:= _
        "=OFFSET(Vt1,MATCH(MIN(Vt1:Vtmax),Vt1:Vtmax,0)-1,)"
ActiveWorkbook.Names.Add Name:="Vtmin2", RefersToR1C1:= _
        "=OFFSET(Vtmax,MATCH(MIN(Vtmax:Vt2),Vtmax:Vt2,0)-1,)"
'Xoa du lieu cu truoc khi loc'
Sheets("boyxin").Select
    Range("A3").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).ClearContents
'AdvancedFilter Unique Beam lay lam vung tam, de tai cot AA'
    Range("Beam").AdvancedFilter Action:=xlFilterCopy, _
        CopyToRange:=Range("AA1"), Unique:=True
    EndB = Range("AA1").End(xlDown).Row
' Tach so de tro giup phan sort beam'
For i = 2 To EndB
Range("AC" & i) = TachSo(Range("AA" & i))
Range("AB" & i) = Left(Range("AA" & i).Value, Len(Range("AA" & i)) - Len(Range("AC" & i)))
Next
'Sorrt Beam'
Range("AA2:AC" & EndB).Select
    Selection.Sort Key1:=Range("AB2"), Order1:=xlAscending, Key2:=Range("AC2" _
        ), Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False _
        , Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
        xlSortNormal
For i = 3 To 3 * (EndB - 1) + 2
    j = WorksheetFunction.RoundUp((i - 2) / 3, 0)
'Dien cac Beam'
    Range("B" & i).Value = Range("AA" & j + 1)
'Nhap cong thuc lay gia tri loc'
    Range("A" & 3 * (j - 1) + 3).FormulaR1C1 = _
        "=OFFSET(Vtmin1,,COLUMNS(C1:C)-MATCH(R2C3,R1C5:R1C10,0)-4)"
    Range("C" & 3 * (j - 1) + 3 & ":L" & 3 * (j - 1) + 3).FormulaR1C1 = _
        "=OFFSET(Vtmin1,,COLUMNS(C1:C)-MATCH(R2C3,R1C5:R1C10,0)-4)"
    Range("A" & 3 * (j - 1) + 4).FormulaR1C1 = _
        "=OFFSET(Vtmax,,COLUMNS(C1:C)-MATCH(R2C3,R1C5:R1C10,0)-4)"
    Range("C" & 3 * (j - 1) + 4 & ":L" & 3 * (j - 1) + 4).FormulaR1C1 = _
        "=OFFSET(Vtmax,,COLUMNS(C1:C)-MATCH(R2C3,R1C5:R1C10,0)-4)"
    Range("A" & 3 * (j - 1) + 5).FormulaR1C1 = _
        "=OFFSET(Vtmin2,,COLUMNS(C1:C)-MATCH(R2C3,R1C5:R1C10,0)-4)"
    Range("C" & 3 * (j - 1) + 5 & ":L" & 3 * (j - 1) + 5).FormulaR1C1 = _
        "=OFFSET(Vtmin2,,COLUMNS(C1:C)-MATCH(R2C3,R1C5:R1C10,0)-4)"
Next
Range("E1").EntireColumn.Hidden = True
Range("G1:I1").EntireColumn.Hidden = True
'Xoa ket qua AdvancedFilter Unique Beam da lay lam vung tam'
Range("AA1:AC1").Select
Range(Selection, Selection.End(xlDown)).Clear
'Goi la gi nhi??? (2)'
With Application
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
MsgBox "Da loc xong theo yeu cau", , "GPE boyxin"
Xoa_CT
End Sub
Sub Xoa_CT()
Sheets("boyxin").Names("Extract").Delete
Set Rng = [A1].CurrentRegion
Rng.Value = Rng.Value
ActiveWorkbook.Names("Beam").Delete
ActiveWorkbook.Names("Vt1").Delete
ActiveWorkbook.Names("Vt2").Delete
ActiveWorkbook.Names("Vtmin1").Delete
ActiveWorkbook.Names("Vtmax").Delete
ActiveWorkbook.Names("Vtmin2").Delete
End Sub
Function TachSo(Chuoi As String) As Long
So = 0
If Len(Chuoi) = 0 Then Exit Function
For j = 1 To Len(Chuoi)
        chu = Mid(Chuoi, j, 1)
        If (Asc(chu) > 47 And Asc(chu) < 58) Then 'ie bang 1, 2, 3...
            So = So & chu
        End If
Next
TachSo = Val(So)
End Function
 
Lần chỉnh sửa cuối:
Upvote 0
Cũng xin tham gia với các bạn tẹo cho vui cửa vui nhà!

1./
File này mình làm khi diễn đàn mới ngưng; Mong tác giả topic kiểm chứng lại chút

PHP:
Option Explicit
Sub XacDinhKhoi()
 Dim Wf As Byte
 Dim Rng As Range
 Dim RwD As Long, RwC As Long
 
 Sheets("Data").Select
 Range([n1], [S65432].End(xlUp)).Clear
 Sheets("Beam").Select
 With Sheets("Beam").Range([b2], [B65432].End(xlUp))
   For Wf = 1 To 255
      Set Rng = .Find(what:="B" & CStr(Wf), LookIn:=xlValues)
      If Rng Is Nothing Then
         RwC = RwD + 1:             RwD = [B65432].End(xlUp).Row
         TimMax RwC, RwD:           Exit For
      Else
         If Wf > 1 Then RwC = RwD + 1
         RwD = Rng.Row - 1
         If Wf > 1 Then TimMax RwC, RwD
      End If
   Next Wf
 End With
End Sub
Mã:
[B]Sub TimMax(Rw1 As Long, Rw2 As Long)[/B]
 Dim Rng As Range, mRng As Range, RngM As Range
 Dim dMax As Double, dMin As Double
 
 Set Rng = Sheets("Beam").Range("F" & Rw1 & ":F" & Rw2)
 dMax = WorksheetFunction.Max(Rng)
 Set RngM = Rng.Find(what:=dMax, LookIn:=xlValues)
 
 Set Rng = Sheets("Beam").Range(Cells(Rw1, "F"), RngM)
 dMin = WorksheetFunction.Min(Rng)
 Set mRng = Rng.Find(what:=dMin, LookIn:=xlValues)
 
 mRng.Offset(, -5).Resize(, 6).Copy _
   Destination:=Sheets("Data").[N65432].End(xlUp).Offset(1)
 RngM.Offset(, -5).Resize(, 6).Copy _
   Destination:=Sheets("Data").[N65432].End(xlUp).Offset(1)
 
 Set Rng = Sheets("Beam").Range(Cells(Rw2, "F"), RngM)
 dMin = WorksheetFunction.Min(Rng)
 Set mRng = Rng.Find(what:=dMin, LookIn:=xlValues)
 
 mRng.Offset(, -5).Resize(, 6).Copy _
   Destination:=Sheets("Data").[N65432].End(xlUp).Offset(1)
   
[B]End Sub[/B]
2./ Hai macro của bạn có thể rút gọn lại tẹo nữa;
Có thể là vầy (Trước dòng lệnh Exĩt Sub):
PHP:
Option Explicit
'Nut Nhap So Lieu --> OK'
Sub InputData()
  Dim n As Integer
  Sheets("Etabs").[B1].CurrentRegion.Copy _
      Destination:=Sheets("Beam1").[a6]
  Columns("G:I").Delete Shift:=xlToLeft
  Columns("E:E").Delete Shift:=xlToLeft
  
Exit Sub
  
  Sheets("Etabs").Activate
    Range(Cells(2, "F"), Cells(n, "F")).Select
    Selection.Copy
  Sheets("Beam").Activate
    Range("E6").Select
    Selection.PasteSpecial Paste:=xlPasteValues
  Sheets("Etabs").Activate
    Range(Cells(2, "J"), Cells(n, "J")).Select
    Selection.Copy
  Sheets("Beam").Activate
    Range("F6").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    
    Range(Cells(6, "A"), Cells(n + 4, "F")).Select  'Select vung du lieu vua Input
    Selection.Sort Key1:=Range("B6"), Order1:=xlAscending, _
      Key2:=Range("D6"), Order2:=xlAscending  'Sort theo thu tu Ascending Beam va Loc
End Sub
'Nut xoa so lieu --> OK'
PHP:
Sub ClearData()
 Range([a6], Cells("H" & [a65500].End(xlUp).Row)).Clear
 Exit Sub
 Dim n As Long
  Range("A6").Select
  Selection.End(xlDown).Select    'End Down va chon Cell cuoi cung
  n = ActiveCell.Row              'Row cua Cell ActiveCell cuoi cung
  Range(Cells(6, "A"), Cells(n, "H")).Select
  Selection.Clear
End Sub
 

File đính kèm

Upvote 0
Đã làm được thành công VBA, Mong các bạn giúp nó chạy nhanh hơn.

1. Hướng lập trình của mình đã trình bày trong #17 mình nghỉ đó là hướng làm đơn giản nhất, nhưng lúc đó trình độ của mình thì không biết bắt đầu từ đâu để làm được theo hướng mà mình nghĩ ra. Cả 1 tuần mình mề mò, và phát hiện lệnh
For Each Cell In Range
Thế là việc diệt qua từng Cell đã thực hiện được, nhưng không biết cách nào để tô đậm ô cần tìm... mình lại tốn thêm gần 1 ngày nữa mới tìm ra --> ra rồi vui ko ke siết.

2. Code mình viết đã thực hiện đúng yêu cầu, rất đơn giản, dẻ hiểu, làm việc được vơi bất kỳ Story or Beam, Nhưng vì mình mới học VBA, nên cấu trúc câu lệnh chưa ưu việt, nó chạy như con rùa, nhảy nhót lung tung, Mong các bạn giúp mình làm cho nó chạy ưu việt nhất, và nhanh nhất, vì nếu dữ liệu dài cả 10.000 hàng thì nó chạy đến mấy chục phút lận (thể hiện rõ nhất khi ấn nút ShortData). ngồi chờ mà sỉu luôn. Mình cũng không biết nên định nghĩa các biến như thế nào là hợp lý (Trong code mình không định nghĩa sao nó vẫn chạy ok nên mình để vậy luôn.hihi, cai này thì không biết, phải nhờ anh em thôi)???

3. Nếu có thể các bạn ghi chú cho mình hiểu những lệnh bạn thêm vào có ý nghĩa gì? làm cho Code chạy nhanh hơn ở phần nào? cho mình hiểu với...Thanks các bạn.

4. Mong GPE thu gọn giúp đoạn Code cua minh cho that đơn giản và ngắn lại.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
1./
File này mình làm khi diễn đàn mới ngưng; Mong tác giả topic kiểm chứng lại chút
End Sub[/PHP]

File của bạn không biết đường nào mà Run hết. Mình phải Run nó và thây kết quả, xong mới kiểm tra Code. Code ban viết mình thử chạy mấy cái mà không thấy có tác dụng gì cả? Không hiểu ý bạn??? Ban co thể nói gợi ý hướng đi của Code của bạn được không? Thanks nhiều.
 
Upvote 0
File của bạn không biết đường nào mà Run hết. Mình phải Run nó và thây kết quả, xong mới kiểm tra Code. Code ban viết mình thử chạy mấy cái mà không thấy có tác dụng gì cả? Không hiểu ý bạn??? Ban co thể nói gợi ý hướng đi của Code của bạn được không? Thanks nhiều.
Bạn qua sheets("DaTa"), xóa các cột từ 'N' đến 'Z'
sau đó cho chạy macro XacDinhKhoi sẽ thấy kết quả trích xuất từ sheets("Beam") sang những cột bạn vừa xóa.
Thật ra trong mảco đã có dòng lệnh này; nhưng bạn làm bằng tay sẽ tác dụng hơn!
:-=--=0
 
Upvote 0
1./
File này mình làm khi diễn đàn mới ngưng; Mong tác giả topic kiểm chứng lại chút
End Sub[/PHP]
Mình chưa hiểu lắm về code của bạn, nhưng kết quả ở sheet Data, từ cột N -> S /Sheet Data là không đúng lắm.
1. Vì Theo điều kiện M3min1 ở Loc đầu
M3max ở giữa
M3min2 ở Loc cuối
Thi khi đó Loc phải tăng giá trị từ nhỏ đến lớn VD B1: có Loc 0-3-6, B2: có Loc 0-1.5-3 là OK
nhưng B3 có Loc: 0-2-0 là không đúng rồi. Cho nên giá trị M3 của B3 cũng sai luôn. Số của file bạn là: -1.993, 1.186, -2.251, nhưng thực tế đúng là: -2.251, 1.186, -2.231 (Bạn có thể tham khảo giá trị đúng ở file của minh ở #23)
2. Không thể đẻ hàng tiêu đề cho dữ liệu được vì mỗi lần Run nó xóa hàng N1 đến S1
Khi sữa lại B1 thành B99 chẳn hạn thì nó không cập nhật B99 vào bảng lọc??
hoặc khi dữ liệu có B1 và B12 thì nó lại hiểu B1 và B12 chung là 1, nên số liệu xuất ra 3 hàng chỉ có B1 mà không có B12?

3. Mong bạn hoàn chỉnh VB theo hướng của bạn đã làm, nếu Run Ok thì đây cung là 1 hương giải quyết hay lắm đó. Tối qua mình đã xêm Code của bạn, cũng có chổ hiểu chổ không. Nhất là câu:
PHP:
Set Rng = .Find(what:="B" & CStr(Wf), LookIn:=xlValues)
Set RngM = Rng.Find(what:=dMax, LookIn:=xlValues)
Mình tra trong cuốn sách VBA của Phan Tu Huong, cung không thấy nói đến hàm Find
Mình muốn hiểu câu lệnh Find ??? mà chưa hiểu???Mong cac ban giúp cho mính 1 vidu đơn giản.
 
Lần chỉnh sửa cuối:
Upvote 0
Chúng ta cùng cải tiến 1 macro xem sao nha!

2. Code mình viết đã thực hiện đúng yêu cầu, rất đơn giản, dẻ hiểu, làm việc được vơi bất kỳ Story or Beam, Nhưng vì mình mới học VBA, nên cấu trúc câu lệnh chưa ưu việt, nó chạy như con rùa, nhảy nhót lung tung, Mong các bạn giúp mình làm cho nó chạy ưu việt nhất, và nhanh nhất, vì nếu dữ liệu dài cả 10.000 hàng thì nó chạy đến mấy chục phút lận (thể hiện rõ nhất khi ấn nút ShortData). ngồi chờ mà sỉu luôn. Mình cũng không biết nên định nghĩa các biến như thế nào là hợp lý (Trong code mình không định nghĩa sao nó vẫn chạy ok nên mình để vậy luôn.hihi, cai này thì không biết, phải nhờ anh em thôi)???
3. Nếu có thể các bạn ghi chú cho mình hiểu những lệnh bạn thêm vào có ý nghĩa gì? làm cho Code chạy nhanh hơn ở phần nào? cho mình hiểu với...Thanks các bạn.
4. Mong GPE thu gọn giúp đoạn Code cua minh cho that đơn giản và ngắn lại.

PHP:
' Option Explicit'
Sub InputData()
1 Dim eRow As Long
 
 Application.ScreenUpdating = False
3 Sheets("Etabs").Activate
 eRow = [B65500].End(xlUp).Row
5 Range([A2], Cells(eRow, "D")).Copy Destination:=Sheets("Beam").[A6]
 Range([F2], Cells(eRow, "F")).Copy Destination:=Sheets("Beam").[E6]
7 Range([J2], Cells(eRow, "J")).Copy Destination:=Sheets("Beam").[F6]
 Sheets("Beam").Select
9 Range([A6], Cells(eRow + 4, "F")).Select
 Selection.Sort Key1:=[B6], _
   Order1:=xlAscending, Key2:=[D6], Order2:=xlAscending
End Sub
Chúng ta cùng bàn luận macro trên, (cái này tôi muốn bạn thay cho cái của bạn!)
Dòng lệnh trên cùng tôi đã vô hiệu hóa bằng dấu nháy đơn trước dòng lệnh
Dòng lệnh đó yêu cầu tất tần tật các biến phải được khai báo tường minh (đầy đủ & tường tận). Điều này mình cho là rất tốt cho những người tự học VBA như chúng ta.
Tuy nhiên tại thời điểm này, chúng ta vô hiệu hóa nó, vì liên quan đến các macro khác bên dưới của bạn.
D1: Khai báo biến eRow có kiểu Long; Tại sao?
Thứ nhất, biến không nên là 1 chữ cái, 1 chữ cái chứa rất ít thông tin; Tôi khai dài như vậy (4 chữ) nhưng ta có thể nhớ là biến này tôi sẽ dùng để lưu giữ giá trị dòng cuối cùng chưa dữ liệu của trang tính. Tất nhiên bạn & tôi đều có thể việt hóa tên biến này, VD: DgCuoi, CDong, DgC . . . Tất cả các tên như vậy làm chúng ta liên tưởng hơn là 1 chữ n vô tri vô giác.
Thêm nữa, tên biến nên có ít nhất 2 ký tự (gồm cả 1 ký số), trong đó nên có từ viết hoa xen lẫn từ viết thường. Việc này để làm gì?
Để tận dụng tiện ích có sẵn trong VBA khi ta viết dòng lệnh không sai sót ngữ pháp. Khi khai tên là vậy, nhưng trong quá trình viết dòng lệnh, ta cứ đánh toàn chữ thường (hoặc toàn chữ in) VBA sẽ chỉ cho ta 1 cách gián tiếp tên biến nào ta nhập sai.
Thứ hai, Tại sao kiểu là Long, mà không là kiểu khác, như Integer, Double, . . . Qui định kiểu của biến nào là do ta sẽ dùng nó vô việc gì; Biến để chứa số dòng trên trang tính thì phải là Long, vì E2003 có tới 65536 dòng trên 1 trang tính; Nếu khai báo dưới hơn có khi bị báo lỗi vào 1 ngày đẹp trời nào đó, lúc đó DL rất nhiều (vượt kiểu Integer), khi đó dễ làm ta phát hoảng, vì mới hôm qua vẫn bình thường, mà hôm nay báo lỗi. Rất nhiều khi, chúng ta cũng không rõ lỗi từ đâu.
D2: Dòng lệnh này đễ màn hình khỏi lắc lư; Rất nhiều người còn nói là nó tăng tốc chương trình. Chúng ta nên tin họ.
D3 là của bạn;
D4: Giá trị dòng cuối chứa DL (dữ liệu). Điều này bạn có thể tiếp thu từ bộ thu macro.
Bạn thử thu macro với các động tác sau:
* Chọn [B65535]
* Bấm tổ hợp 2 fím Ctrl & [mũi tên lên]
D4 đảm bảo rằng chúng ta tới dòng cuối của cột 'B' chứa dữ liệu
Các dòng lệnh của bạn, cũng đáng tin, nhưng chỉ đáng tin với CSDL của bạn sản sinh ra mà thôi. (Tại sao ư? - Bạn thử tìm hiểu 1 thời gian xem. . .)
3 dòng kế tiếp sau D4 là chép 3 vùng cần thiết từ trang tính này sang trang tính kia;
Hai dòng cuối là của bạn; Tất nhiên mình có sửa 1 tẹo, ở chổ địa chỉ ô; Một khi ta xác định ô rõ ràng rồi, thì không nên trừu tượng hóa nó làm gì. Để sau này chúng ta đỡ tốn thời gian vì nó.

Chúc vui!
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
PHP:
D4 đảm bảo rằng chúng ta tới dòng cuối của cột 'B' chứa dữ liệu
Các dòng lệnh của bạn, cũng đáng tin, nhưng chỉ đáng tin với CSDL của bạn sản sinh ra mà thôi. (Tại sao ư? - Bạn thử tìm hiểu 1 thời gian xem. . .)
3 dòng kế tiếp sau D4 là chép 3 vùng cần thiết từ trang tính này sang trang tính kia;
Hai dòng cuối là của bạn; Tất nhiên mình có sửa 1 tẹo, ở chổ địa chỉ ô; Một khi ta xác định ô rõ ràng rồi, thì không nên trừu tượng hóa nó làm gì. Để sau này chúng ta đỡ tốn thời gian vì nó. 
 [/QUOTE]
1. Mình có thể hiểu ý bạn. nếu dùng 
[COLOR="#ff00ff"]eRow = [B65500].End(xlUp).Row[/COLOR]
Thì ta sẽ từ dưới di lên đến Cells cuối cùng của dữ liệu, điều này tránh trường hộp dữ liệu bị ngắt quản ở giữa (nghĩa là khi dữ liệu đột xuất có dòng trống). Khi đó [COLOR="#ff00ff"].End(xlDown).Row[/COLOR] sẽ đến đoạn ngắt đó mà không đến được cuối Dữ liệu (Không biết có đúng với ý bạn không?).
2. Đoạn InputData có thể xêm là đã gọn hơn rồi. Mong các bạn làm gọn Code nút Nut FilterData , ShortData, ClearData. [B][COLOR="#ff00ff"]Phứt tạp và dài dòng nhất là FilterData. Còn chạy chậm nhất là ShortData.[/COLOR][/B]
File gởi kềm ở bài [B][COLOR="Magenta"]#23[/COLOR][/B]
 
Lần chỉnh sửa cuối:
Upvote 0
Anh HYen17 ơi, em xin trình bày hướng em làm bài của pmhoang như sau, anh thấy giải thuật có hợp lý không nhé.
1/ Từ cột B tạo ra danh mục Beam duy nhất, và sort theo B1, B2, B..., B11, B12...
2/ Duyệt qua DMBeam, dùng Advance Filter (AV) => chi tiết theo Beam=iBeam, sort chi tiết này theo Loc.
3/ Tìm MaxLoc (dòng cuối), MinLoc (dòng đầu) => EndLocDau (MaxLoc/4) và FirstLocCuoi (MaxLoc/4*3). => Vị trí (dòng) của thông số trên. => KqRng.
4/ Từ KqRng => min của M3, Max M3 tùy theo điều kiện lọc.
5/ Tìm vị trí min của M3, Max M3 theo KqRng => dòng min của M3, Max M3, => gán vào Beam.
Ý tưởng là vậy như mà triển khai thấy công phú quá.
Nếu dùng for i hay For eachCell thì dễ hiểu hơn như mà sẽ chậm hơn.
Anh cụ thể theo phương án này hộ em với.
Nhờ có bài này mà em mới nhớ là AF có thể hiểu B1 và B11 như nhau. (may mà phát hiện, mặc dù đã có bài nói về vấn đề này).
Cám ơn Anh nhiều.
 
Upvote 0
Hỏi các bạn về giải thuật của mình, Các bạn cho ý kiến cái.
Mình đinh ninh rằng, nếu hiểu đúng yêu cầu tác giả thì giải thuật của mình không kém ai về tốc độ.
* Tạo vòng lặp tìm lần lượt các B(i). Sau mỗi lần tìm sẽ có 2 chỉ số dòng của đầu & cuối
vùng của Beam thứ (i). Tận dụng được ưu điểm về tốc độ của phương thức FIND()
* Sau khi ta có vùng này, đem đến macro khác để xử lý nó, gồm các công đoạn:
- Tìm Giá trị Max trong vùng nhờ hàm của Excel
- Tìm ô/dòng chứa giá trị Max này - lại nhờ FIND()
(Tiếp sau tác giả còn cho sai; Mình cho là mình chưa hiểu đúng yêu cầu)
- Tìm cực tiểu trong khoảng từ ô đầu tiên của vùng cho đến giá trị Max nêu trên - cũng nhờ hàm Min trong excel;
- Xác định dòng chứa dữ liệu Min này - bằng FIND()
- Chép 2 dòng này sang sheet mới
- Tìm cực tiểu trong đoạn dưới còn lại
- Xác định dòng tương ứng (bằng FIND()) & chép sang nơi mới
(Quá trình được lặp cho đến hết số Beam)

Các bạn chỉ cho mình, rằng mình chưa hiểu đúng chổ nào được không?
Xin cảm ơn các bạn trước nha!
 
Upvote 0
Nhưng vì mình mới học VBA, nên cấu trúc câu lệnh chưa ưu việt, nó chạy như con rùa, nhảy nhót lung tung, Mong các bạn giúp mình làm cho nó chạy ưu việt nhất, và nhanh nhất, . . .
3. Nếu có thể các bạn ghi chú cho mình hiểu những lệnh bạn thêm vào có ý nghĩa gì? làm cho Code chạy nhanh hơn ở phần nào? cho mình hiểu với...Thanks các bạn.

4. Mong GPE thu gọn giúp đoạn Code cua minh cho that đơn giản và ngắn lại.
Mình cho rằng macro này chỉ 1 dòng lệnh duy nhất cũng OK
PHP:
'Nut ClearData --> OK'
Sub ClearData()
  Range("A6").Select
  Selection.End(xlDown).Select
  n = ActiveCell.Row
  Range(Cells(6, "A"), Cells(n, "H")).Select
  Selection.Clear
End Sub
Ví dụ nha:
Mã:
[B]Sub CleaRegion()[/B] 
    Range([A6], [H65500].End(Xlup)).Clear
[B]End Sub[/B]
Bạn có thể dùng lệnh MsgBox Range([A6], [H65500].End(Xlup)).Address để chiêm nghiệm
 
Upvote 0
Mình cho rằng macro này chỉ 1 dòng lệnh duy nhất cũng OK
PHP:
Ví dụ nha:
[code] 
[B]Sub CleaRegion()[/B] 
    Range([A6], [H65500].End(Xlup)).Clear
[B]End Sub[/B]
[/code]
Bạn có thể dùng lệnh [B]MsgBox Range([A6], [H65500].End(Xlup)).Address[/B] để chiêm nghiệm[/quote]
 
thêm application.ScreenUpdating=false  
cho nhanh một chút
 
Upvote 0
Hỏi các bạn về giải thuật của mình, Các bạn cho ý kiến cái.
Mình đinh ninh rằng, nếu hiểu đúng yêu cầu tác giả thì giải thuật của mình không kém ai về tốc độ.
* Tạo vòng lặp tìm lần lượt các B(i). Sau mỗi lần tìm sẽ có 2 chỉ số dòng của đầu & cuối
vùng của Beam thứ (i). Tận dụng được ưu điểm về tốc độ của phương thức FIND()
1. Giải thuật của bạn phải công nhận là làm việc rất nhanh, Có thể nói hiện giờ chưa có Code nào qua mặt, Mong bạn bổ sung thêm để nó Run Ok, Mình rất hi vọng về Giải thuật của bạn. Mong sẽ nhận được sản phẩm hoàn chỉnh. (vì Cái Find() mình chưa hiểu hiết nên không biết đường sửa chữa thêm vào Code của bạn, Sorry...)

2. Mình chưa hiểu về cách dùng Find()???. Mong bạn giúp mình 1 vd đơn giản mình sẽ chỉ ra chổ sai cho bạn. Còn bây giờ mình kiểm tra thủ công bằng cách cho xuất ra các giá trị đầu và cuối Beam của từng loại Beam thì mình thấy có chổ sai, đây là kết quả lần lược khi Run Code của bạn.
Rw1=3, Rw2=50 -> TR/B1 (Đúng) - Là số dòng đầu và cuối của B1 Thuộc Story TR
Rw1=51, Rw2=74 -> Beam TR/B2 - Đúng
75, 106 -> TR/B3 - Đúng
107, 154 -> TR/B4 - Đúng
155, 202 -> TR/B5 - Đúng
203, 267 -> TR/B6 và LAU1/B6 - Sai - vì bạn đã chọn 1 lúc 2 Loại Beam để xuất ra 3 giòng Mmin1, Mmax, Mmin2 - Kết quả xuất ra sẽ thiếu Beam LAU1/B6 (thiếu)
268, 399 -> LAU1/B7 , LAU1/B9, LAU1/B12 nó hiểu là 1, chon nên chỉ xuất ra kết quả là LAU1/B7, thiếu đi B9, B12 - Bạn có thể xêm kết quả Run của Code của bạn sẽ rõ.


Nội dung và yêu cầu có ghi đầy đủ và rõ ràng trong file gởi kềm ở Bài #1. Cảm ơn sự quang tam của Anh SA_DQ, và các bạn.
File DieukienLoc là file gốc chưa lọc
File DieukienLoc - ghichu2 là file đã tô mà xanh nhưng ô thỏa diều kiện cho bạn dẻ hình dung.
còn file ở BÀi #23 là file đúng, Bạn Ấn nút Inputdata (nhập Data vào và Sort theo Beam và Loc) -> FilterData (Tô màu đỏ và đậm nhưng ô thỏa điều kiện) -> Shortdata (Rút ngắn mỗi loại Beam còn lại 3 hàng) sẽ ra kết quá đúng, Nếu kết quả của file bạn làm ra như thế là OK (Ghi chú: File DieuKienLoc-PMH chỉ cho ra kết quả đúng còn Run thì như con rùa, cần các bạn hoàn chỉnh thêm)
 
Lần chỉnh sửa cuối:
Upvote 0
Em xin trình bày hướng làm bài như sau,
1/ Từ cột B tạo ra danh mục Beam duy nhất, và sort theo B1, B2, B..., B11, B12...
2/ Duyệt qua DMBeam, dùng Advance Filter (AV) => chi tiết theo Beam=iBeam, sort chi tiết này theo Loc.
3/ Tìm MaxLoc (dòng cuối), MinLoc (dòng đầu) => EndLocDau (MaxLoc/4) và FirstLocCuoi (MaxLoc/4*3). => Vị trí (dòng) của thông số trên. => KqRng.
4/ Từ KqRng => min của M3, Max M3 tùy theo điều kiện lọc.
5/ Tìm vị trí min của M3, Max M3 theo KqRng => dòng min của M3, Max M3, => gán vào Beam.
Ý tưởng là vậy như mà triển khai thấy công phú quá.
Mình xin đề xuất sửa phương án của ThuNghi xíu; Nếu chúng ta thỏa thuận được phương án, mình sẽ biến nó thành hiện thực:

(Coi như dữ liệu đã được xếp theo cột 'B' (Beam))
Khai báo 2 biến DDau & DCuoi kiểu Long (để ghi dòng đầu & dòng cuối của 1 Beam cụ thể nào đó khi dùng vòng lặp duyệt theo cột 'B') & 1 biến chuỗi tạm để ghi nhận 1 khi Beam thay đổi từ dòng trên xuống dòng dưới
Tất nhiên vào đầu vòng lặp DDau = Row1 (=6)
Khi Beam chuyển từ B10 =>> B110 thì ta có vùng Range("B" & DDau & ":B" & DCuoi)
Ta đem vùng này sang macro khác xử lý, như sau:
* Tìm giá trị max trong vùng nhờ hàm của excel
* Tìm địa chỉ ô ứng với giá trị max này (MaxAddress)
* Tìm Giá trị Min trong vùng thuộc Range("B" & DDau & ":B" & MaxAddress.Row
* Lại tìm địa chỉ ứng với giá trị Min1
(+) Chép hai dòng tìm được sang Sheet mới
Lặp lại lần nữa để tìm Min2 & lại chép dòng thứ ba sang sheet mới

(Do các file ban đầu tác giả đưa ra các Beam liên tục nên mình tạo hướng đi sai;)

Mong tin của ThuNghi về vấn đề này!
 
Upvote 0
Mình xin đề xuất sửa phương án của ThuNghi xíu; Nếu chúng ta thỏa thuận được phương án, mình sẽ biến nó thành hiện thực:

1. Phương án của bạn giống như phương án mình đã làm trong file ở bài #23 (bạn có thể xêm Code trong file), nhưng mình không biết tận dụng được các hàm Excel và MaxAddress cho nên cách viết của mình rất là dài.

Chú ý: Có thể trong dữ liệu có 2 Beam trùng tên, nhưng thực tế không phải là dữ liệu sai. mình ví dụ ở Story TR ta có Beam B6, Lên Story LAU1 ta lại có Beam B6, điều này thực tế không có sai. vì vậy khi thay đồi vùng chọn để tính từng loại, Beam này sang Beam khác phải thỏa mãn OR (Beam thay doi, Story thay đổi).

2. Thân chào. Mong gốp ý của HYen17 va ThuNghi
 
Upvote 0
Mình xin đề xuất sửa phương án của ThuNghi xíu; Nếu chúng ta thỏa thuận được phương án, mình sẽ biến nó thành hiện thực:

(Coi như dữ liệu đã được xếp theo cột 'B' (Beam))
Khai báo 2 biến DDau & DCuoi kiểu Long (để ghi dòng đầu & dòng cuối của 1 Beam cụ thể nào đó khi dùng vòng lặp duyệt theo cột 'B') & 1 biến chuỗi tạm để ghi nhận 1 khi Beam thay đổi từ dòng trên xuống dòng dưới
Tất nhiên vào đầu vòng lặp DDau = Row1 (=6)
Khi Beam chuyển từ B10 =>> B110 thì ta có vùng Range("B" & DDau & ":B" & DCuoi)
Ta đem vùng này sang macro khác xử lý, như sau:
* Tìm giá trị max trong vùng nhờ hàm của excel
* Tìm địa chỉ ô ứng với giá trị max này (MaxAddress)
* Tìm Giá trị Min trong vùng thuộc Range("B" & DDau & ":B" & MaxAddress.Row
* Lại tìm địa chỉ ứng với giá trị Min1
(+) Chép hai dòng tìm được sang Sheet mới
Lặp lại lần nữa để tìm Min2 & lại chép dòng thứ ba sang sheet mới
Em cũng nghĩ giải pháp như vậy nhưng chưa hiểu ý tác giả là: tìm Min1 và Min2 trong khỏang loc như thế nào.
Ví dụ ta có: Beam=X100 có LocMin là 0, LocMax là 12.
Vậy phải làm rõ trong khỏang Loc nào => Min1, và =>Min2
Em nghĩ như sau: Lọc chia thành 3 phần (có thể ứng với Beam=iBeam có thể có xuất hiện 2 lần Loc=3 or =1
- Trong khỏang 0<=Loc<=LocMax/4 => Min1
- Trong khỏang LocMax/4*3<=Loc<=LocMax => Min2
- Trong khỏang LocMax/4<=Loc<=LocMax/4*3 => Max.
Giải quyết OK vấn đề này thì sẽ đơn giản hơn. Em thắc mắc mấy dấu "=" hay "<=" hay "<"
 
Upvote 0
1
Chú ý: Có thể trong dữ liệu có 2 Beam trùng tên, nhưng thực tế không phải là dữ liệu sai. mình ví dụ ở Story TR ta có Beam B6, Lên Story LAU1 ta lại có Beam B6, điều này thực tế không có sai. vì vậy khi thay đồi vùng chọn để tính từng loại, Beam này sang Beam khác phải thỏa mãn OR (Beam thay doi, Story thay đổi).
Vậy lúc này thì xác định lọc theo Beam hay Beam và Story
Giả dụ:
Beam= B6, Story là LAU1 có maxLoc là 6
Beam= B6, Story là TR có maxLoc là 8
Lúc này là 2 phần khác nhau hay sao.
 
Upvote 0
Mình xin đề xuất sửa phương án của ThuNghi xíu; Nếu chúng ta thỏa thuận được phương án, mình sẽ biến nó thành hiện thực:

(Coi như dữ liệu đã được xếp theo cột 'B' (Beam))
Khai báo 2 biến DDau & DCuoi kiểu Long (để ghi dòng đầu & dòng cuối của 1 Beam cụ thể nào đó khi dùng vòng lặp duyệt theo cột 'B') & 1 biến chuỗi tạm để ghi nhận 1 khi Beam thay đổi từ dòng trên xuống dòng dưới
Tất nhiên vào đầu vòng lặp DDau = Row1 (=6)
Khi Beam chuyển từ B10 =>> B110 thì ta có vùng Range(&quot;B&quot; & DDau & &quot;:B&quot; & DCuoi)
Ta đem vùng này sang macro khác xử lý, như sau:
* Tìm giá trị max trong vùng nhờ hàm của excel
* Tìm địa chỉ ô ứng với giá trị max này (MaxAddress)
* Tìm Giá trị Min trong vùng thuộc Range(&quot;B&quot; & DDau & &quot;:B&quot; & MaxAddress.Row
* Lại tìm địa chỉ ứng với giá trị Min1
(+) Chép hai dòng tìm được sang Sheet mới
Lặp lại lần nữa để tìm Min2 & lại chép dòng thứ ba sang sheet mới

(Do các file ban đầu tác giả đưa ra các Beam liên tục nên mình tạo hướng đi sai;)

Mong tin của ThuNghi về vấn đề này!
Theo hướng chuẩn rồi đó. Cụ thể là thế này
Theo boyxin: thuật toán phải thế này,
Tìm vị trí đầu của mỗi Beam Vt1
Tìm vị trí cuối của mỗi Beam Vt2

chuyển sang code khác thực hiện ứng với mỗi loại Beam (từ dưới lên)
Tìm MAX(Vt1:Vt2) => Vtmax

Tìm MIN(Vt1:Vtmax) => Vtmin1

Tìm MIN(Vtmax:Vt2) => Vtmin2
Giữ lại các record ... tìm được

Next
đã thực hiện bằng công thức ra kết quả chuẩn nhưng có điều với số lương record nhiều thì tốc độ hạn chế
 
Lần chỉnh sửa cuối:
Upvote 0
Mình chưa hiểu lắm về code của bạn, Tối qua mình đã xêm Code của bạn, cũng có chổ hiểu chổ không. Nhất là câu:
PHP:
Set Rng = .Find(what:="B" & CStr(Wf), LookIn:=xlValues)
Set RngM = Rng.Find(what:=dMax, LookIn:=xlValues)
Mình tra trong cuốn sách VBA của Phan Tu Huong, cung không thấy nói đến hàm Find
Mình muốn hiểu câu lệnh Find ??? mà chưa hiểu???Mong cac ban giúp cho mính 1 vidu đơn giản.
Bạn đến đây tham khảo tạm
http://www.giaiphapexcel.com/forum/showthread.php?t=12301

Nhưng nó không phải là hàm, mà là phương thức của VBA

Trong phần giúp đỡ của VBA, phương thức được giải thích như sau:

Finds specific information in a range, and returns a Range object that represents the first cell where that information is found. Returns Nothing if no match is found. Doesn’t affect the selection or the active cell.
For information about using the Find worksheet function in Visual Basic, see Using Worksheet Functions in Visual Basic.
expression.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
expression Required. An expression that returns a Range object.
What Required Variant. The data to search for. Can be a string or any Microsoft Excel data type.
After Optional Variant. The cell after which you want the search to begin. This corresponds to the position of the active cell when a search is done from the user interface. Note that After must be a single cell in the range. Remember that the search begins after this cell; the specified cell isn’t searched until the method wraps back around to this cell. If you don’t specify this argument, the search starts after the cell in the upper-left corner of the range.
LookIn Optional Variant. The type of information.
LookAt Optional Variant. Can be one of the following XlLookAt constants: xlWhole or xlPart.
SearchOrder Optional Variant. Can be one of the following XlSearchOrder constants: xlByRows or xlByColumns.
SearchDirection Optional XlSearchDirection. The search direction.
XlSearchDirection can be one of these XlSearchDirection constants.xlNext defaultxlPrevious

MatchCase Optional Variant. True to make the search case sensitive. The default value is False.
MatchByte Optional Variant. Used only if you’ve selected or installed double-byte language support. True to have double-byte characters match only double-byte characters. False to have double-byte characters match their single-byte equivalents.
SearchFormat Optional Variant. The search format.
Remarks

The settings for LookIn, LookAt, SearchOrder, and MatchByte are saved each time you use this method. If you don’t specify values for these arguments the next time you call the method, the saved values are used. Setting these arguments changes the settings in the Find dialog box, and changing the settings in the Find dialog box changes the saved values that are used if you omit the arguments. To avoid problems, set these arguments explicitly each time you use this method.
You can use the FindNext and FindPrevious methods to repeat the search.
When the search reaches the end of the specified search range, it wraps around to the beginning of the range. To stop a search when this wraparound occurs, save the address of the first found cell, and then test each successive found-cell address against this saved address.
To find cells that match more complicated patterns, use a For Each...Next statement with the Like operator. For example, the following code searches for all cells in the range A1:C5 that use a font whose name starts with the letters Cour. When Microsoft Excel finds a match, it changes the font to Times New Roman.
For Each c In [A1:C5] If c.Font.Name Like "Cour*" Then c.Font.Name = "Times New Roman" End IfNext
Example

This example finds all cells in the range A1:A500 on worksheet one that contain the value 2 and changes it to 5.
PHP:
With Worksheets(1).Range("a1:a500") 
    Set c = .Find(2, lookin:=xlValues) 
    If Not c Is Nothing Then 
         firstAddress = c.Address 
         Do 
             c.Value = 5 
             Set c = .FindNext(c) 
         Loop While Not c Is Nothing And c.Address <> firstAddress 
     End If 
End With
:-=
 
Lần chỉnh sửa cuối:
Upvote 0
To ThuNghi & BoyXyn

Hai bạn chạy thử macro sau & cho ý kiến, giúp nha!
PHP:
Option Explicit
Sub DestinationBlock()
 Dim eRow As Long, fRow As Long, lRow As Long, sRow As Long
 Dim rRng As Range, Rng As Range
 Dim GPE_Address As String
 
 Sheets("Beam").Select:                   Application.ScreenUpdating = False
 eRow = [B65432].End(xlUp).Row
 Sheets("Data").Select:                   Range([a2], Cells(eRow, "H")).Clear
 Sheets("Beam").Select
 
 With Sheets("Beam").Range("B6:B" & eRow)
   sRow = 6
   Do
      Set Rng = .Find(what:=Cells(sRow, "b"), LookIn:=xlValues, LookAt:=xlWhole)
      If Not Rng Is Nothing Then
         Set rRng = Rng
         GPE_Address = Rng.Address
         Do
            Set rRng = Union(rRng, Rng)
            Set Rng = .FindNext(Rng)
         Loop While Not Rng Is Nothing And Rng.Address <> GPE_Address
      End If
      If Not rRng Is Nothing Then
         MsgBox rRng.Offset(, -1).Resize(, 6).Address, , rRng.Rows.Count + sRow
         sRow = rRng.Rows.Count + sRow
      Else:                               End If
      If sRow > eRow Then Exit Do
   Loop
 End With
 End Sub
:-=--=0}}}}}@$@!^%
(Mới nữa chặng thôi; nhưng nếu đúng thì sẽ là 10% còn lại để đến đích mà thôi
Vì cái macro thứ hai ở trên sẽ xài được, không việc gì âu lo!)
 
Upvote 0
Vậy lúc này thì xác định lọc theo Beam hay Beam và Story
Giả dụ:
Beam= B6, Story là LAU1 có maxLoc là 6
Beam= B6, Story là TR có maxLoc là 8
Lúc này là 2 phần khác nhau hay sao.

1. Số liệu nguyên thủy là luôn giữa nguyên ở Sheet Etabs (Đó là từ Phần mền xuất ra - nó luôn liên tục từ hàng trên xuống hàng dưới không có ngắt quản)
2. Ta InputData từ Sheet Etabs vào Sheet Beam, Ở Sheet Beam ta Sort nó theo 3 điều kiện 1. Story 2.Beam 3.Loc
Khi đó mỗi Beam vẫn đảm bảo có Lóc đi từ nhỏ đến lớn. Mình sẽ sớm Up lên 1 file có Data Chuẩn có đủ mọi trường hợp cụ thể trong file cho các bạn tham khảo. (Đã upfile lên ở bài #45)
Than chào
....
Thân chào.
Em cũng nghĩ giải pháp như vậy nhưng chưa hiểu ý tác giả là: tìm Min1 và Min2 trong khỏang loc như thế nào.
1. Cái này thì thành thật Sorry anh ThuNghi. Vì khi mới Upfile lên hỏi GPE, em không biết nên hỏi từ đâu. Trong file em có vẽ cả cái biểu đồ biến đổi của M3, theo biểu đồ thì M3 sẽ di từ nhỏ ở Lóc đầu tiên, sau đó tăng lên đến M3 Max ở giữa Loc (Ở vùng giữa thôi, chứ không chắc là ở chính giữa) và đến gần cuối Lóc thì nhỏ lại.
Mà mình thì chỉ cần 3 giá trị, 1. M3min1, M3max, M3min2, cho nên khi anh ThuNghi hỏi em là cụ thể lấy M3min1 ở vùng nào, em mới vd là khoảng 1/4 vì thường là như thế, vì lúc đó em đâu có biết hướng đi của bài toán này đâu.
Sau đó ở các bài #2, #3 gì đó em đã nghĩ ra hướng đi. và có phát biểu hướng đi. nhưng thấy chưa có bạn nào đi theo hương đó. Em phải tự lực cách sinh..hihi...

2. Cái vụ này thì làm theo cách 1/4 cũng cho ra kết quả như làm theo cách của HYen17, (vì nhìn vào biểu đồ thay đổi của M3 là suy ra 2 cách se cho ra cùng kết quả, Biểu đồ trong file ở bài đầu tiên #1).
3. Mong ThuNghi Sorry cho minh.
 
Lần chỉnh sửa cuối:
Upvote 0
Tôi lấy thử 1 Beam=B6.
Bạn hãy cho ra 2 kết quả theo Sheet1 và Sheet2. Nếu có thể vẽ đồ thị M3 theo Loc. Tôi không hiểu làm thế nào vẽ đồ thị khi có 2 lần Loc=0.
Và nếu có thể cho biết tại sao chọn những M3.
Phải hiểu thì làm mới được. Từ Code của bạn khó suy diễn.
 

File đính kèm

Upvote 0
Beam

Theo hướng của HYen17 tôi làm ra thế này, có đúng không?
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Hai bạn chạy thử macro sau & cho ý kiến, giúp nha!
PHP:
Option Explicit
Sub DestinationBlock()
 Dim eRow As Long, fRow As Long, lRow As Long, sRow As Long
 Dim rRng As Range, Rng As Range
 Dim GPE_Address As String
 
 Sheets(&quot;Beam&quot;).Select:                   Application.ScreenUpdating = False
 eRow = [B65432].End(xlUp).Row
 Sheets(&quot;Data&quot;).Select:                   Range([a2], Cells(eRow, &quot;H&quot;)).Clear
 Sheets(&quot;Beam&quot;).Select
 
 With Sheets(&quot;Beam&quot;).Range(&quot;B6:B&quot; & eRow)
   sRow = 6
   Do
      Set Rng = .Find(what:=Cells(sRow, &quot;b&quot;), LookIn:=xlValues, LookAt:=xlWhole)
      If Not Rng Is Nothing Then
         Set rRng = Rng
         GPE_Address = Rng.Address
         Do
            Set rRng = Union(rRng, Rng)
            Set Rng = .FindNext(Rng)
         Loop While Not Rng Is Nothing And Rng.Address <> GPE_Address
      End If
      If Not rRng Is Nothing Then
         MsgBox rRng.Offset(, -1).Resize(, 6).Address, , rRng.Rows.Count + sRow
         sRow = rRng.Rows.Count + sRow
      Else:                               End If
      If sRow > eRow Then Exit Do
   Loop
 End With
 End Sub
:-=--=0}}}}}@$@!^%
(Mới nữa chặng thôi; nhưng nếu đúng thì sẽ là 10% còn lại để đến đích mà thôi
Vì cái macro thứ hai ở trên sẽ xài được, không việc gì âu lo!)

Xác định dòng đầu (vt1), dòng cuối (vt2) của mỗi Beam chuẩn rồi
Xét theo M3, (cột có tiêu đề là M3) việc cần làm tiếp theo là

1- Tìm vị trí của giá trị MAX của vùng (vt1:vt2) vtmax
2- Tìm vị trí của giá trị MIN của vùng đầu (vt1:vtmax) vtmin1
3- Tìm vị trí của giá trị MIN của vùng sau (vtmax:vt2) vtmin2
4- Xét từ cuối lên trên, Mỗi Beam giữ lại 3 dòng ứng với các giá trị vtmin1, vtmax, vtmin2 vừa tìm được thế là OK
 
Upvote 0
File Tổng hộp các trường hợp mà Data có thể sẫy ra.

Mình đã tổng hợp 1 trường hợp chung nhất cho Data. Và cũng kềm theo cách làm và ghi chú rõ ràng trong file. Có giải thích.
Có sự phân biệt giữa các Beam
Vd: Beam B4 - Story L1
Beam B4 - Story L2 ... vv..

và Beam B3 - Story L1
Beam B4 - Story L1 ... vv..

Theo đúng yêu cầu của anh ThuNghi
Thân chào
 

File đính kèm

Upvote 0
Vậy Hòang làm cụ thể theo file tôi gởi lên (chỉ có 1 Beam thôi) thì đáp án thế nào, cụ thể
LocDau, LocGiua, LocCuoi là những khỏan nào => M3.
 
Upvote 0
Vậy Hòang làm cụ thể theo file tôi gởi lên (chỉ có 1 Beam thôi) thì đáp án thế nào, cụ thể
LocDau, LocGiua, LocCuoi là những khỏan nào => M3.
Mình phân tích file của bạn đây. (file cua ban trong bai #42)
Thực chât file của minh vừa send là bao hàm cả file của bạn rồi.
File bạn:
Ở sheet kiemtra01 thực tế là 1 Beam B6/TR (Beam B6 thuộc tầng trệt)
Ở sheet kiemtra02 thực tế là 2 Beam B6/TR và B6/LAU1

Nhưng Số liệu của bạn do bạn chỉnh sửa ngẫu nhiên nên xẫy ra trường hợp bị phân đoạn, nghĩa là Phần tử B6/TR bị đứt làm hai. B6/TR từ hàng 2 -> 15
Tiếp theo B6/TR từ hàng hàng 29 -> 33

Nhưng vì nó cùng 1 tên là B6/TR nên nó thuộc 1 phần tử. Nếu để số liệu như vậy vô tình ta lam cho 1 phần tử trở nên không trọn vặn, VD như Thằng Cu tên Nguyen Văn B6/TR, có Cái Đầu và cái Mình ở trên, Rồi sau đó đến bộ phận cơ thể của Nguyen Van B6/LAU1, tiếp theo mới đến cái chân Của Nguyen Van B6/TR...
Thế thì Nguyen Van B6/TR làm sao sống nổi. (Bị đứt như vậy là chết chắc)-> Không thể xẫy ra

Vì vậy bạn phải làm 1 thao tác nối Cái đầu (Đầu Loc) và Cái Mình (Giữa Loc) với Cái chân (Cuối Loc) lại. thế thì Nguyen Van B4/TR sẽ sống lại. khi đó nó sẽ tự có các Loc tăng lên từ nhỏ đến lớn cho bạn chọn.

Cụ thể (mình đã hiểu ý bạn) nên theo như mình nói ở bài #45, bạn hãy Sort Data của Kiemtra02 theo 1.Story 2.Beam 3.Loc
Sẽ thấy xuất hiện 2 loại Beam B4/TR -> có đầy đủ cac Loc
và B4/LAU1 -> có đầy đủ các Loc

Chú ý: Số liệu đúng từ phần mền xuất ra luôn có Loc tăng từ nhỏ đến lớn, bạn không sợ có trường hợp nào khác.
Chờ mình 1 tí, mình sẽ vẽ hình minh họa vì sao lại cùng Loc = 0 lại có 2 giá trị M3...

Than chào
 
Lần chỉnh sửa cuối:
Upvote 0
Beam

Bạn xem thử file này.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Cuối cùng rồi cũng xong!

PHP:
Option Explicit
Sub DestinationBlock()
 Dim eRow As Long, fRow As Long, lRow As Long, sRow As Long
 Dim rRng As Range, Rng As Range
 Dim GPE_Address As String
 
 Sheets("Beam").Select:                   Application.ScreenUpdating = False
 eRow = [B65432].End(xlUp).Row
 Sheets("Data").Select:                   Range([a2], Cells(eRow, "H")).Clear
 Sheets("Beam").Select
 
 For sRow = 6 To eRow
   Cells(sRow, "I").Value = Cells(sRow, 1) & Cells(sRow, "B").Value
 Next sRow
 
 With Sheets("Beam").Range("I6:I" & eRow)
   sRow = 6
   Do
      Set Rng = .Find(what:=Cells(sRow, "I"), LookIn:=xlValues, LookAt:=xlWhole)
      If Not Rng Is Nothing Then
         Set rRng = Rng
         GPE_Address = Rng.Address
         Do
            Set rRng = Union(rRng, Rng)
            Set Rng = .FindNext(Rng)
         Loop While Not Rng Is Nothing And Rng.Address <> GPE_Address
      End If
      If Not rRng Is Nothing Then
         TimMax rRng.Cells(1, 1).Row, rRng.Offset(rRng.Rows.Count).Row - 1
         sRow = rRng.Rows.Count + sRow
      Else:                               End If
      If sRow > eRow Then Exit Do
   Loop
 End With
 Range([i6], Cells(eRow, "I")).Clear
 End Sub

Macro TimMax ở trên đã có
 

File đính kèm

Upvote 0
File của bạn Dựa trên nguyên tắc, chọn và to hồng các M3 thỏa yêu cẩu và Ẩn các hàng còn lại. Nhưng bạn lại dùng vùng tạm để ghi dữ liệu tính toán. Cái này cũng có thể được nến dữ liệu o vùng tạm là trống, chứ nếu ở đó có công thức thì xem như bị đè mất công thức , hihi.
Mình đã kiểm tra . OK lắm thanks ban nhiều ! Tốt độ sử lý cũng rất nhanh.

Tôc độ chốp mắt...:clapping::clap2: Thanks nhiều. Mình sẽ cố gắng kiểm tra.
 
Lần chỉnh sửa cuối:
Upvote 0
Góp ý bạn pmhoang về sub ShortData của bạn :
Bạn tìm điều kiện và delete các dòng thừa trong vòng lặp cho nên bị chậm.
Vòng lặp chỉ tìm điều kiện thôi.
Khi delete thì thực hiện 1 lần cho tất cả các dòng này, thời gian sẽ nhanh hơn.
Ví dụ như sub sau :

PHP:
Sub short_data()
Columns(7).ClearContents
For N = 6 To [F65500].End(xlUp).Row
    If Cells(N, 6).Font.ColorIndex = 7 Then
        Cells(N, 7) = 1
    End If
Next N
Range([A6], Cells([F65500].End(xlUp).Row, "g")).Select
    Selection.Sort Key1:=[G6], Order1:=xlAscending, _
    Key2:=[A6], Order2:=xlAscending, Key3:=[B6], Order3:=xlDescending _
       Range(Cells([G65500].End(xlUp).Row + 1, "g"), _
       Cells([F65500].End(xlUp).Row, "g")).EntireRow.Delete
Range([G6], Cells([F65500].End(xlUp).Row, "g")).ClearContents
End Sub

Bạn thử xem.
(Sub này dựa trên dữ liệu bạn đang có nên chưa tối ưu, nhưng cũng đã nhanh hơn ShortData của bạn rồi đó. Bạn chỉnh sửa lại theo ý bạn thì nó còn nhanh hơn).
 
Upvote 0
Góp ý bạn pmhoang về sub ShortData của bạn :
Bạn tìm điều kiện và delete các dòng thừa trong vòng lặp cho nên bị chậm.
Vòng lặp chỉ tìm điều kiện thôi.
Khi delete thì thực hiện 1 lần cho tất cả các dòng này, thời gian sẽ nhanh hơn.
Ví dụ như sub sau :

PHP:
Sub short_data()
Columns(7).ClearContents
For N = 6 To [F65500].End(xlUp).Row
    If Cells(N, 6).Font.ColorIndex = 7 Then
        Cells(N, 7) = 1
    End If
Next N
Range([A6], Cells([F65500].End(xlUp).Row, "g")).Select
    Selection.Sort Key1:=[G6], Order1:=xlAscending, _
    Key2:=[A6], Order2:=xlAscending, Key3:=[B6], Order3:=xlDescending _
       Range(Cells([G65500].End(xlUp).Row + 1, "g"), _
       Cells([F65500].End(xlUp).Row, "g")).EntireRow.Delete
Range([G6], Cells([F65500].End(xlUp).Row, "g")).ClearContents
End Sub
Bạn thử xem.
(Sub này dựa trên dữ liệu bạn đang có nên chưa tối ưu, nhưng cũng đã nhanh hơn ShortData của bạn rồi đó. Bạn chỉnh sửa lại theo ý bạn thì nó còn nhanh hơn).
Nếu đã for next thì tại sao không delete row luôn mà phải gán =1 rồi sort, thường cái này nên delete từ dưới lên.
PHP:
Sub shortdata()
Dim ERow As Long, iR As Long
Sheets("Beam").Select
ERow = [F65500].End(xlUp).Row
For iR = ERow To 6 Step -1
    If Cells(N, 6).Font.ColorIndex <> 7 Then
        Rows(N).Delete Shift:=xlUp
    End If
Next iR
End Sub
Phần Sub InputData()
1/ Không copy và dán
Ví dụ:
ERow = [B65500].End(xlUp).Row
Range([a2], Cells(ERow, "D")).Copy Destination:=Sheets("Beam").[A6]
Sao không dùng
Range([a2], Cells(ERow, "D")).value=Sheets("Beam").("A6:D" & Erow+6-2).value
2/Nếu có
Application.ScreenUpdating = False
Thì cuối code phải có
Application.ScreenUpdating = True
Từ từ xem và sẽ góp ý theo code của Hòang.
Phát hiện thêm nữa, Sub RowBeam() nếu Data chỉ có 1 Beam duy nhất thì
If Cells(N, "B").Value = Cells(N + 1, "B").Value Then
N = N + 1
Else
RowCuoiBeam = N
If RowDauBeam = 1 Then
RowDauBeam = 6
End If
Sẽ sai.
 
Upvote 0
Nếu đã for next thì tại sao không delete row luôn mà phải gán =1 rồi sort, thường cái này nên delete từ dưới lên.
Thường thì chương trình được viết sao cho (1) đơn giản, ngắn gọn, (2) dễ hiểu, dễ hình dung, (3) thực thi nhanh, (4) … Đạt được tất cả thì rất tốt, nhưng khó. Khi đó phải chọn thứ nào được ưu tiên hơn. Việc này tùy yêu cầu đề bài, tùy người, tùy năng lực máy,…

Sau này tốc độ máy tính đã nhanh hơn xưa nhiều nên xu hướng (1) (2) lấn át (3) (nói đúng ra thì sự chậm hơn của (1) (2) so với (3) là không thấy rõ, chấp nhận được).
Tuy nhiên có những lúc sự chậm hơn là đáng kể, cho nên việc viết lại thuật giải sao cho cải thiện tốc độ thực thi lại trở thành việc cần thiết.
Tôi thấy lệnh Delete Row thực hiện rất chậm. Trường hợp có không nhiều dòng cần delete thì có thể delete ngay trong vòng lặp, nhưng nếu số dòng cần delete khá nhiều thì thời gian thực thi sẽ đến mức đáng kể.
Cho nên tôi gom các dòng cần delete lại để rồi thực hiện delete một lần mà thôi. Làm thế này thì cũng có cái dở là sử dụng cột phụ, giải thuật thì khó hiểu hơn so với delete trong vòng lặp, nhưng thỏa nguyện vọng về tốc độ thực thi.
 
Upvote 0
Tôi thấy lệnh Delete Row thực hiện rất chậm. Nếu số dòng cần delete khá nhiều thì thời gian thực thi sẽ đến mức đáng kể.
Cho nên tôi gom các dòng cần delete lại để rồi thực hiện delete một lần mà thôi. Làm thế này thì cũng có cái dở là sử dụng cột phụ, giải thuật thì khó hiểu hơn so với delete trong vòng lặp, nhưng thỏa nguyện vọng về tốc độ thực thi.
Nếu chúng ta không dùng cột phụ mà dùng phương thức UNION() để gom các dòng cần delete, chắc cũng tiện hơn xíu!.--=0:-=}}}}}
PHP:
 Dim DelRng As Range
. . . . 
 If DelRng Is Nothing Then
     Set DelRng = [Ai].EntireRow
 Else
      Set DelRng = Union(DelRng, [Ai].EntireRow)
End If
 DelRng.Delete
 
Upvote 0
lypt đã viết:
For N = 6 To [F65500].End(xlUp).Row
If Cells(N, 6).Font.ColorIndex <> 7 Then
Cái này thì mỗi lần lặp VB phải thực hiện lệnh [F65500].End(xlUp).Row điều này chỉ khi nào [F65500].End(xlUp).Row thay đổi thì được, còn [F65500].End(xlUp).Row là 1 hằng số thì cách này sẽ làm VB Run chậm hơn là code sau:
PHP:
eRow=[F65500].End(xlUp).Row
For N = 6 To eRow



Phát hiện thêm nữa, Sub RowBeam() nếu Data chỉ có 1 Beam duy nhất thì
Sẽ sai.
Chiều hôm qua, khi kiểm tra lại, phát hiện ra chổ sai đó, và sửa lại cho đúng là: (Thanks ThuNghi)
PHP:
 If Cells(n, "A").Value = Cells(n + 1, "A").Value And Cells(n, "B").Value = _
               Cells(n + 1, "B").Value Then
      n = n + 1
    Else
      RowCuoiBeam = n
      If RowDauBeam = 1 Then
        RowDauBeam = 6
      End If
2. Đoạn code ShortData của bạn phai sửa lại N thành iR như sau:
PHP:
Sub shortdata_ThuNghi()
Dim ERow As Long, iR As Long
Sheets("Beam").Select
ERow = [F65500].End(xlUp).Row
For iR = ERow To 6 Step -1
    If Cells(iR, 6).Font.ColorIndex <> 7 Then
        Rows(iR).Delete Shift:=xlUp
    End If
Next iR
End Sub
Nhưng xêm ra tốc độ Delete trong For Next cũng không khác hơn trong Do Loop như code của mình. Nó rất chậm. Cach của bạn lypt thì dùng sort cot "G"=1 và Delete 1 vùng sau khi sort là rất nhanh, nhưng phải dùng vùng tạm. Còn hướng đi của ChanhTQ thì set từng vùng 1, rồi Union, cứ tiếp tục Union như thế ta se có 1 Union gồm tất cả các hàng sẽ delete và thực hiện 1 lần delete. Đó là cách mà tôi tự hiểu... chứa trong Code của ChanhTQ thì chưa hiểu lắm về [Ai]. mong bạn CTQ hoàn chỉnh nó thành 1 sub nhe.

Nếu chúng ta không dùng cột phụ mà dùng phương thức UNION() để gom các dòng cần delete, chắc cũng tiện hơn xíu!.--=0:-=}}}}}
PHP:
 Dim DelRng As Range
. . . . 
 If DelRng Is Nothing Then
     Set DelRng = [Ai].EntireRow
 Else
      Set DelRng = Union(DelRng, [Ai].EntireRow)
End If
 DelRng.Delete
Nếu nhìn qua thì thấy cái này hay. nhưng chưa hiểu lắm về [Ai] bạn có thể cụ thể hóa trong Sub ShorData đi. (có phải ý bạn là chọn 1 Union gồm nhiều vùng - tất cả các vùng cần delete rồi delete 1 lần ???
 
Lần chỉnh sửa cuối:
Upvote 0
Nếu chúng ta không dùng cột phụ mà dùng phương thức UNION() để gom các dòng cần delete, chắc cũng tiện hơn xíu!
Đúng vậy, cám ơn.

Nếu nhìn qua thì thấy cái này hay. nhưng chưa hiểu lắm về [Ai] bạn có thể cụ thể hóa trong Sub ShorData đi. (có phải ý bạn là chọn 1 Union gồm nhiều vùng - tất cả các vùng cần delete rồi delete 1 lần ???
Đưa đoạn đó vào vòng lặp. Thay [Ai] bằng địa chỉ cells kiểm tra.
Mã:
  [FONT=Verdana]Sub Short_Data()[/FONT]
  [FONT=Verdana]Dim DelRng As Range[/FONT]
  [FONT=Verdana]For N = 6 To [F65500].End(xlUp).Row[/FONT]
  [FONT=Verdana]    If Cells(N, 6).Font.ColorIndex <> 7 Then[/FONT]
  [FONT=Verdana]         If DelRng Is Nothing Then[/FONT]
  [FONT=Verdana]             Set DelRng = Cells(N, 6).EntireRow[/FONT]
  [FONT=Verdana]         Else[/FONT]
  [FONT=Verdana]              Set DelRng = Union(DelRng, Cells(N, 6).EntireRow)[/FONT]
  [FONT=Verdana]        End If[/FONT]
  [FONT=Verdana]    End If[/FONT]
  [FONT=Verdana]Next N[/FONT]
  [FONT=Verdana]DelRng.Delete[/FONT]
  [FONT=Verdana]End Sub[/FONT]
 
Upvote 0
Mình thay đổi For n= 6 to [F65500].End(xlUp).Row
bằng For n = 6 To eRow VB chỉ tìm giá trị xlUP 1 lần thôi -> sẽ nhanh hơn
Mình thay đổi Set DelRng = Cells(n, 6).EntireRow còn lại Set DelRng = Cells(n, 6) làm như vậy sẽ ít tốn bộ nhớ của VB hơn, vì ở đây bộ nhớ chỉ nhớ 1 Cell, so với EntireRow là 256 Cell
PHP:
Sub ShortData_ChanhTQ_Lypt_Pmh()
Dim DelRng As Range
eRow = [F65500].End(xlUp).Row
For n = 6 To eRow
  If Cells(n, 6).Font.ColorIndex <> 7 Then
    If DelRng Is Nothing Then 
      Set DelRng = Cells(n, 6)
    Else
      Set DelRng = Union(DelRng, Cells(n, 6))
    End If
  End If
Next n
DelRng.EntireRow.Delete
End Sub
Nhưng chỉ thấy nhanh lên hơn 1 tí. vẫn còn chậm lắm...(chậm hơn đoạn code của lypt - chon vùng tạm - rat nhiều)
Mình nghĩ tại vì Set DelRng = Union(DelRng, Cells(n, 6)) mỗi lần chỉ Union có 1 Cell cho nen công việc Union rất là nhiều. Nếu thay: Set DelRng = Union(DelRng, Vùng giữa 2 giá trị có màu hồng) khi đó khối lượng Union sẽ giảm lại => tốc độ sẽ cao hơn. Mong Lypt và CTQ chuyển thể nó với.

Mình mới tìm ra 1 lệnh chọn vùng không cần vùng phải liên tục miễn sao thỏa điều kiện nào đó. Ơ đây là vùng thỏa điều kiện Cell trống.
SpecialCells(xlCellTypeBlanks) Mình đã chỉnh lại Sub của bạn Lypt theo cách này các bạn xem thử cú ưu việt không?

PHP:
Sub short_data_lypt_PMH()
Columns(7).ClearContents
eRow = [F65500].End(xlUp).Row
For n = 6 To eRow
    If Cells(n, 6).Font.ColorIndex = 7 Then
        Cells(n, 7) = 1
    End If
Next n
Set Rng = Range([G6], Cells(eRow, "G")).SpecialCells(xlCellTypeBlanks)
Rng.EntireRow.Delete
Range([G6], Cells(eRow, "g")).ClearContents
End Sub

Nhưng như nếu dùng SpecialCells(xlCellTypeBlanks) được, mình nghĩ sẽ phải có 1 Lệnh tương tự có tác dụng chọn tất cả các vùng khi Cells Format là mặc định, Khi đó ta không dùng vùng tạm nữa, mà chọn trực tiếp vào cột M3. Ta chọn 1 lúc các Cells format = mặc định (không tô màu, không màu hồng). rồi thực hiện Delete 1 lần.
Lây hay mãi vẫn không tìm ra cấu trúc lệnh như suy nghỉ, Các bạn có phương án gì? giúp mình với.
 
Lần chỉnh sửa cuối:
Upvote 0
Mình thay đổi For n= 6 to [F65500].End(xlUp).Row
bằng For n = 6 To eRow VB chỉ tìm giá trị xlUP 1 lần thôi -> sẽ nhanh hơn
Theo tôi thì không nhanh hơn vì eRow vẫn là “biến” chứ không phải “hằng”. Ta có thể cảm giác được eRow không đổi, nhưng máy thì không có cảm giác đó, máy vẫn nhìn eRow là “biến” và vì vậy khi vòng For quay lại máy vẫn hỏi eRow là bao nhiêu cũng giống như máy hỏi [F65500].End(xlUp).Row là bao nhiêu – 2 cái hỏi này là như nhau. Tôi đã kiểm tra thực tế và không thấy nhanh hơn (mà không thấy nhanh hơn thì : thêm eRow là tốn thêm 1 biến, đồng thời mất thêm một lệnh gán biến đó, lệnh này có mất thời gian nhưng vì chỉ một lệnh nên không cảm nhận thời gian tính này).

(chậm hơn đoạn code của lypt - chon vùng tạm - rat nhiều)
Trong trường hợp dữ liệu cụ thể của bạn thì giải thuật của ChanhTQ có chậm hơn của tôi, nhưng trong trường hợp tổng quát thì không như thế đâu nhé, thậm chí có thể nhanh hơn, điều này tùy thuộc vào dữ liệu có tỉ lệ giữa số dòng cần để lại và số dòng phải xóa đi như thế nào.

Mình đã chỉnh lại Sub của bạn Lypt theo cách này các bạn xem thử cú ưu việt không?
Theo tôi thì không nhanh hơn vì lệnh làm chậm chính là lệnh “Cells(n, 7) = 1” nằm trong vòng lặp ấy – nhìn thấy đơn giản có 1 dòng lệnh nhưng nó được thực hiện rất nhiều lần theo vòng lặp. Còn cái chỗ bạn đề nghị sửa thì nó không làm chậm chương trình đâu.

mình nghĩ sẽ phải có 1 Lệnh tương tự có tác dụng chọn tất cả các vùng khi Cells Format là mặc định, Khi đó ta không dùng vùng tạm nữa, mà chọn trực tiếp vào cột M3. Ta chọn 1 lúc các Cells format = mặc định (không tô màu, không màu hồng). rồi thực hiện Delete 1 lần.
Chính xác là tôi cũng đang tìm chỗ này đây, nhưng đến giờ vẫn chưa thấy.

Trong khi chờ đợi tìm ra thì mời quay lại với chương trình của tôi với một chút cải biên là vẫn dùng vùng tạm nhưng không sử dụng vùng mới (cột G) mà là khai thác vùng đang có với các chú ý nhất định. Cụ thể chọn cột A chẳng hạn, ta thấy cột A là một cột dữ liệu có sẵn và cũng là cột Key1 khi thực hiện Sort dữ liệu. Dữ liệu cột A là Text. Ta tìm một ký tự thỏa điều kiện vừa khác vừa lớn hơn (về thứ tự trong máy, nhỏ hơn cũng được nhưng sắp xếp sẽ khác) so với tất cả các ký tự có trong dữ liệu cột A (ví dụ ký tự “Z”, có thứ tự lớn hơn tất cả ký tự cột A). Tại các dòng cần chừa lại (không delete) ta thêm ký tự này vào trước dữ liệu cột A. Chọn vùng dữ liệu tất cả, sắp xếp dữ liệu theo cột A, tăng dần. Chọn vùng dữ liệu cột A, tìm ký tự này bằng lệnh Find, xác định được vị trí này, xác định được vùng cần xóa dữ liệu và xóa đi các dòng thừa. Nói ra thì dài dòng nhưng thực chất số lệnh trong vòng lặp chỉ có một lệnh là “thêm ký tự Z vào cột A” thay cho lệnh “đặt giá trị 1 ở vùng tạm cột G”; các lệnh khác là nằm ngoài vòng lặp và không ảnh hưởng đáng kể đến tốc độ. Tôi đã kiểm tra thực tế tốc độ chạy không bị chậm hơn (chạy với dữ liệu 10.000 records). Cụ thể Sub :

Mã:
  [FONT=Verdana]Sub Short_Data()[/FONT]
  [FONT=Verdana]For n = 6 To [F65500].End(xlUp).Row[/FONT]
  [FONT=Verdana]    If Cells(n, 6).Font.ColorIndex = 7 Then[/FONT]
  [FONT=Verdana]        Cells(n, 1) = "Z" & Cells(n, 1)[/FONT]
  [FONT=Verdana]    End If[/FONT]
  [FONT=Verdana]Next n[/FONT]
  [FONT=Verdana]Range([A6], Cells([F65500].End(xlUp).Row, "F")).Select[/FONT]
  [FONT=Verdana]    Selection.Sort _[/FONT]
  [FONT=Verdana]    Key1:=[A6], Order1:=xlAscending, _[/FONT]
  [FONT=Verdana]    Key2:=[B6], Order2:=xlAscending[/FONT]
  [FONT=Verdana]eRow2 = Range([A6], Cells([F65500].End(xlUp).Row, "A")).Find(What:="Z").Row - 1[/FONT]
  [FONT=Verdana]Range([A6], Cells(eRow2, "A")).EntireRow.Delete[/FONT]
  [FONT=Verdana]Range([A6], Cells([F65500].End(xlUp).Row, "A")).Select[/FONT]
  [FONT=Verdana]Selection.Replace What:="Z", Replacement:=""[/FONT]
  [FONT=Verdana]End Sub[/FONT]

Trong quá trình bạn tìm các dòng Max, Min1, Min2 (theo Function M3_Bold) rồi tô đậm và tô màu để phân biệt thì bạn có thể kết hợp thêm “Z” vào cột A luôn cũng được; khi đó Short_Data sẽ không có vòng lặp và không bị chậm. Nhưng mà M3_Bold của bạn sẽ bị chậm vì phải gánh thêm lệnh (cái chậm này có khi lại lớn hơn mới chết chứ!).
Cuối cùng, những lệnh trong vòng lặp là nguồn chính làm chậm chương trình cho nên chỉ sử dụng những lệnh thật cần thiết trong vòng lặp. Giờ thì đi tìm lệnh chọn vùng “cells format” xem sao! Nếu có sẽ báo cho bạn.
 
Chỉnh sửa lần cuối bởi điều hành viên:
Upvote 0
Thôi tôi gán vào 1 cell như lypt và sort là nhanh nhất, tôi đã test với 50.000 row thì chỉ có cách gán và sort lại là nhanh. Tôi đã thử
if true then cells(i,6).clearcontents và sort lại cũng không nhanh = cells(i,7)=1 và sort.
 
Upvote 0
Từ ý của bạn ChanhTQ tôi đã khai thác lệnh Union nhưng có đổi lại điều kiên như sau :
- Theo bạn ChanhTQ thì do Union các dòng cần delete nên số lượng rất nhiều, và lệnh thực thi trong vòng lặp cũng nhiều.
- Tôi đổi lại, sử dụng Union cho những dòng lệnh chừa lại, số lượng sẽ ít hơn nên lệnh thực thi trong vòng lặp sẽ ít hơn.
- Vấn đề là xóa các dòng thừa và chép các dòng để lại như thế nào?
- Tôi đã lấy Union tổng hợp được khi nãy chép vào một vùng trống mới (dưới dòng cuối cùng chẳng hạn), rồi delete tất cả các dòng cũ. Quả nhiên là được. Và nhanh hơn hẳn. Các bạn thử xem nhé.

PHP:
Sub Short_ChanhTQ()
  Dim Rng As Range
  For n = 6 To [F65500].End(xlUp).Row
      If Cells(n, 6).Font.ColorIndex = 7 Then
           If Rng Is Nothing Then
               Set Rng = Cells(n, 6).EntireRow
           Else
                Set Rng = Union(Rng, Cells(n, 6).EntireRow)
          End If
      End If
  Next n
  Rng.Select
  Selection.Copy
  Cells([F65500].End(xlUp).Row + 1, "A").Select
  ActiveSheet.Paste
  Range([A6], Cells(ActiveCell.Row - 1, "A")).EntireRow.Delete
  [A6].Select
  End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Đến lúc này, mình có câu hỏi ngu ngơ thế này:
Tại sao các bạn lại đi tìm những records đã tô đậm/tô màu thế kia chứ; Trước đây các bạn tìm ra chúng & Format chúng, phải không?
Ý mình muốn nói là đễ tìm nhanh 1 loạt Records nào thì phương thức FIND() vẫn là trên cả tuyệt vời. Càng tuyệt vời hơn nếu chúng là số ít như các bạn thấy các macro bên trên. Sao ta không tiếp tục theo hướng này cái nhỉ?
}}}}}:=\+@$@!^%
 
Upvote 0
Đến lúc này, mình có câu hỏi ngu ngơ thế này:
Tại sao các bạn lại đi tìm những records đã tô đậm/tô màu thế kia chứ; Trước đây các bạn tìm ra chúng & Format chúng, phải không?
Ý mình muốn nói là đễ tìm nhanh 1 loạt Records nào thì phương thức FIND() vẫn là trên cả tuyệt vời. Càng tuyệt vời hơn nếu chúng là số ít như các bạn thấy các macro bên trên. Sao ta không tiếp tục theo hướng này cái nhỉ?
}}}}}:=\+@$@!^%
Đang kiểm tra lại xem có đúng không?
 
Lần chỉnh sửa cuối:
Upvote 0
Mình có một vấn đề nhờ các cao thủ GPE giúp :
Mình cần lọc những HSG, HSTT ở bảng nguồn vào bảng đích kèm theo vị thứ từ 1 -> .., tên tương ứng, điểm TB tương ứng và đặc biệt là khi thay đổi số liệu bảng nguồn thì bảng đích cũng thay đổi ( không dùng VBA, filter )
 
Lần chỉnh sửa cuối:
Upvote 0
Mình có một vấn đề nhờ các cao thủ GPE giúp :
Mình cần lọc những HSG, HSTT ở bảng nguồn vào bảng đích kèm theo vị thứ từ 1 -> .., tên tương ứng, điểm TB tương ứng và đặc biệt là khi thay đổi số liệu bảng nguồn thì bảng đích cũng thay đổi ( không dùng VBA, filter )
Có thể dùng VLOOKUP, INDEX...Bạn đưa file lên đi.
 
Upvote 0
Xin lỗi vì vừa qua tôi bận quá. Cảm ơn bác ! Đây là file đính kèm.
 

File đính kèm

Upvote 0
Xin lỗi vì vừa qua tôi bận quá. Cảm ơn bác ! Đây là file đính kèm.
Bài này Bạn dùng Advanced Filter là được. Trong file Toi có ghi 1 macro để tiện cập nhật dữ liệu. Bạn xem file có đúng ý chưa nhé!
 

File đính kèm

Upvote 0
Cảm ơn bác Minhcong , bài của bác đã gần đúng ý em nhưng phiền bác nghĩ tiếp cho là nếu sheet bị lock thì có lỗi và nếu nháy chuột vào " Lọc khen thưởng" thì có làm hiện được 1 report kết quả và cả lệnh in cho nó không ? Nhờ bác và các thầy giúp cho.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Em không hiểu lắm. Anh/chị có thể nói chi tiết hơn được không ? Em Thank nhiều nhiều
 
Upvote 0
Nói thật là mình dốt excel nên không dễ gì hiểu được.
 
Upvote 0
Em có bài toán về lọc dữ liệu từ bảng dọc sang bảng ngang muốn nhờ anh chị trong diễn đàn giúp đỡ! Yêu cầu em đã ghi rõ trong file đính kèm. Mong học hỏi nhiều kiến thức hay từ anh chị! Em chân thành cảm ơn!
 

File đính kèm

Upvote 0
Em có bài toán về lọc dữ liệu từ bảng dọc sang bảng ngang muốn nhờ anh chị trong diễn đàn giúp đỡ! Yêu cầu em đã ghi rõ trong file đính kèm. Mong học hỏi nhiều kiến thức hay từ anh chị! Em chân thành cảm ơn!
Bạn xem file có đúng ý chưa nhé!
 

File đính kèm

Upvote 0
Mình cám ơn bạn rất nhiều mình sẽ chạy thử vào bảng dữ liệu của mình! Bạn cho mình email của bạn được không? Có gì thắc mắc mình sẽ hỏi bạn nhé! Thanks!
 
Lần chỉnh sửa cuối:
Upvote 0
Chào anh Minh Công! Em đã hiểu những name động mà anh dùng trong công thức, tuy nhiên khi em di chuyển bảng dữ liệu của em sang địa chỉ khác thì công thức nó chạy không đúng. Em tải file lên nhờ anh và các chị giúp đỡ em giải quyết bài toán này!
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Chào anh Minh Công! Em đã hiểu những name động mà anh dùng trong công thức, tuy nhiên khi em di chuyển bảng dữ liệu của em sang địa chỉ khác thì công thức nó chạy không đúng. Em tải file lên nhờ anh và các chị giúp đỡ em giải quyết bài toán này!
MÌnh kiểm tra lại thấy đúng mà, sai chỗ nào đâu nhỉ? Tại ô B48 Bạn có thể thay công thức thành như sau:
Mã:
=IF([COLOR=red]B$47[/COLOR]>COUNT(dulieu);"";OFFSET($C$1;SMALL(dulieu;[COLOR=red]B$47[/COLOR])-1;0))
Để ý cái B$47 nhé! Nó thay cho COLUMNS($A$1:A$1) ở trên ấy.
 

File đính kèm

Upvote 0
Em vừa sửa lại file đính kèm, anh xem lại giúp em nhé!
 
Upvote 0
Nhờ các cao thủ xem và lọc dùm bài này bằng công thức được không? xin cảm ơn nhiều
 

File đính kèm

Upvote 0
mình có vấn đề này cần mọi người giúp với, trong excell ví dụ cột A mình nhập dữ liệu dạng số chẳng hạn: 101,102,103,108,109,110. trong dáy số này mình sẽ sort từ nhỏ tới lớn rồi, ko biết những nhóm số liên tiếp nhau mình có cách nào gộp lại không, ví dụ như nhóm: 101,102,103 thì tự động ghi ra cho mình là:101-103. còn 108,109,110 thi ghi ra cho mình là: 108-110, cột A của mình rất nhiều số mình muốn excel nó gộp lại như vậy, mọi người giúp mình với nha.
 
Upvote 0
Tôi có một Sheet1 chứa dữ liệu xuất hàng trong nhiều ngày, tôi muốn Shheet2 chỉ cần gỗ ngày cần lấy thì tự chạy ra như File đính kèm. Các bác giúp em với
Tks!
 
Upvote 0
Tôi có một Sheet1 chứa dữ liệu xuất hàng trong nhiều ngày, tôi muốn Shheet2 chỉ cần gõ ngày cần lấy thì tự chạy ra như File đính kèm. Các bác giúp em với
Tks!
 

File đính kèm

Upvote 0

File đính kèm

Upvote 0
Bạn xem file đính kèm nhé

Mình ko giỏi lắm nhưng vấn đề của bạn thì mình giải quyết tốt
 

File đính kèm

Upvote 0
Cần lọc dữ liệu ngẫu nhiên từ dãy kí tự có sẵn

Chào cả nhà. Lâu rồi mới có dịp ghé diễn đàn và làm phiền mọi người. Tôi có một dãy kí tự rất dài bao gồm cả kí tự đặc biệt và muốn rút gọn xuống còn 6 kí tự không có kí tự đặc biệt. Nội dung như file đính kèm, Kính nhờ các cao thủ chỉ giúp. Chúc cả nhà vui vẻ.
 

File đính kèm

Upvote 0
Chào cả nhà. Lâu rồi mới có dịp ghé diễn đàn và làm phiền mọi người. Tôi có một dãy kí tự rất dài bao gồm cả kí tự đặc biệt và muốn rút gọn xuống còn 6 kí tự không có kí tự đặc biệt. Nội dung như file đính kèm, Kính nhờ các cao thủ chỉ giúp. Chúc cả nhà vui vẻ.
Dùng công thức này xem có giúp đc bạn ko:
Mã:
=LEFT(SUBSTITUTE(B2,"-",""),6)
 
Upvote 0
Chào cả nhà. Lâu rồi mới có dịp ghé diễn đàn và làm phiền mọi người. Tôi có một dãy kí tự rất dài bao gồm cả kí tự đặc biệt và muốn rút gọn xuống còn 6 kí tự không có kí tự đặc biệt. Nội dung như file đính kèm, Kính nhờ các cao thủ chỉ giúp. Chúc cả nhà vui vẻ.
Bạn thử công thức này :
=MID(SUBSTITUTE(B2,"-",""),RANDBETWEEN(1,LEN(SUBSTITUTE(B2,"-",""))-6),6) .
 
Upvote 0
Cảm ơn các bác đã giúp đỡ, chúc năm mới vui vẻ
 
Upvote 0
Cảm ơn bác tuy nhiên em xin lỗi vì chưa nói rõ ý. Ở đây em muốn 6 kí tự lấy ra phải là ngẫu nhiên chứ không phải dãy liên tiếp ngẫu nhiên
 
Upvote 0
Cảm ơn bác tuy nhiên em xin lỗi vì chưa nói rõ ý. Ở đây em muốn 6 kí tự lấy ra phải là ngẫu nhiên chứ không phải dãy liên tiếp ngẫu nhiên

- Nếu lấy tùy ý thì có thể kết hợp hàm MID + RANDBETWEEN (gần giống bài 83)
- Nếu lấy theo điều kiện không trùng (ký tự lấy rồi sẽ không lấy nữa) thì bạn phải dùng VBA
 
Upvote 0
Cảm ơn bác tuy nhiên em xin lỗi vì chưa nói rõ ý. Ở đây em muốn 6 kí tự lấy ra phải là ngẫu nhiên chứ không phải dãy liên tiếp ngẫu nhiên

Lý do tại sao phải ngẫu nhiên?

Lý do tôi hỏi là vì có thể điều kiện ngẫu nhiên của bạn có thể còn nhiều nữa nhưng bạn chưa thấy hết. Đến lúc nhìn kết quả rồi bạn mới biết không đúng ý mình, vd:

Ngẫu nhiên như thế nào? có cần giữ lại vị trí tương đối các ký tự, nếu A đứng trước B trong mã nguyên thuỷ thì B có được đứng trước A trong mã mới? Nếu một ký tự lặp lại nhiều lần trong mã nguyên thuỷ thì mã mới có quyền lặp lại mấy lần?
 
Lần chỉnh sửa cuối:
Upvote 0
Chị HYEN17 ơi. Nếu cái file của chị trong cột load có nhiều trường hợp ví dụ như TT, HT,... thÌ mình muốn sửa lại code không cho xóa các trường hợp đó như thế nào vậy chị.
 
Upvote 0
HYEN17 ơi. Nếu cái file của chị trong cột load có nhiều trường hợp ví dụ như TT, HT,... thÌ mình muốn sửa lại code không cho xóa các trường hợp đó như thế nào vậy chị.
Bạn hỏi nhưng lại không trích dẫn bài nào thì cũng khó cho người được hỏi;

Bạn đến đây tiếp tục thảo luận đi nè: http://www.giaiphapexcel.com/forum/...á-trị-cục-đại-của-1-tiêu-chí-Đưa-bài-giúp-bạn
 
Upvote 0

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

Back
Top Bottom