Làm macro với nội dung hơi khó & dài ! (6 người xem)

Liên hệ QC

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

nguyen86dong

Thành viên chính thức
Tham gia
26/3/09
Bài viết
57
Được thích
6
Hằng ngày, em sẽ có một file excel (file đính kèm 1), yêu cầu đặt ra cho em là khi mở file đính kèm 1 chạy macro nó sẽ tìm các mã cố định cho trước với các cột có tên tương ứng (file đính kèm 2) tìm trong file đính kèm 1 và chép lên một sheet khác của file đính kèm 1. Vì ngày nào cũng chạy nên không quan tâm tới ngày tháng. Anh chị nào có thể giúp em làm macro này, em đã làm bằng combo box nhưng sếp không đồng ý rùi. Còn làm bằng macro thì em chưa làm nổi (đang nghiên cứu hà !) Em cám ơn trước.
 
Lần chỉnh sửa cuối:
Bạn đưa lên quá nhiều trang tính mà không nói rõ được là cần chép từ trang tính

Các cột cần lấy giá trị nằm ở trang tính nào;

Xin nhắc bạn 1 điều rằng những gì bạn làm hàng ngày & quá quen thuộc thì là những cái hoàn toàn mới toanh với những người khác trong cộng đồng: Sao bạn lại có thể phí phạm thời gian của người khác muốn giúp bạn đến vậy?
 
Xin lỗi bạn, mình ghi thiếu !

Các tên cột cần lấy nằm trong file đính kèm 2, còn giá trị cần lấy nếu trong tên cột có chữ normal hoặc (N) thì lấy trong sheet "Cell data Normal", nêu không có thì lấy giá trị trong sheet "Cell data Peak" trong các sheet của file đính kèm 1.Bạn giúp mình nhe. Bạn nói mình như thế mình chưa hiểu. Nếu có gì giải thích rõ để mình hiểu zí.
 
Các tên cột cần lấy nằm trong file đính kèm 2, còn giá trị cần lấy nếu trong tên cột có chữ normal hoặc (N) thì lấy trong sheet "Cell data Normal", nêu không có thì lấy giá trị trong sheet "Cell data Peak" trong các sheet của file đính kèm 1.Bạn giúp mình nhe.

Tốt nhất bạn nên đưa lên 1 file thôi, gồm 4 trang tính:
"Cell data Normal", "Cell data Peak", "DSach" & "KQua"

& trong trang "KQua" bạn phải đưa ra vài dòng mà đáng ra nó có. & cả 2 lần viết bài bên trên bạn không nói là trong trang "KQua" này sẽ gồm những trường /cột nào.

Hãy chớ viết những gì bạn hiểu, mà phải viết sao cho mọi người khác hiểu!
 
Mình đưa lên đủ chi tiết đây !

Cám ơn mọi người đã góp ý và giúp, em có nói là hằng ngày mình phải tải file mới về, nên làm macro mình sẽ chuyển thành add-in luôn (đuôi *.xla), khi mình mở file mới tải về và mở lên, thì add-in này sẽ được load lên. và khi chạy nó, thì nó sẽ tạo ra 1 sheet mới cũng trên file này, các tên cột cần lấy em tô màu xanh dương trong file đính kèm sau, các mã cần tìm là tô màu xanh lá, và trong sheet KQua_Vidu là kết quả ví dụ khi chạy nó sẽ lấy được. Còn các mã cần lấy đầy đủ nằm trong sheet danhsach, các cột cần lấy cũng mang tên như trong file trên. giá trị cần lấy thì trong sheet Cell data peak, nếu trong tên cột có chữ Normal hoặc (N) thì lấy trong sheet Cell data Normal.
Có gì không hiểu thì cho mình hay liền, nhớ giúp mình, số điện thoại của mình: 01699.122.221, có gì nhắn tin cho mình hay mình sẽ điện lại cho, sẽ nói rõ hơn.
 
Lần chỉnh sửa cuối:
Đã thấy cửa cuối của đường hầm

PHP:
Option Explicit

Sub TongHop()
 Const N1 As String = "Normal":           Const N2 As String = "N)"
 Dim Sh As Worksheet, Sh0 As Worksheet
 Dim Rng As Range, Clls As Range, pRng As Range, sRng As Range
 Dim Cll1 As Range, kRng As Range, fRng As Range, Rngs As Range
 Dim eRw As Long
 
 Sheets("KQua").Select:                   Set Sh = Sheets("DSach")
 eRw = [B65500].End(xlUp).Row:            Set Sh0 = Sheets("Peak")
 If eRw > 1 Then Range("B2:iV" & eRw).ClearContents
 Set Rng = Sh.[b2].CurrentRegion
 Set pRng = Sh0.Range(Sh0.[d1], Sh0.[d1].End(xlDown))
 Set kRng = Range([c1], [c1].End(xlToRight))
 Set fRng = Sh0.Range(Sh0.[e1], Sh0.[e1].End(xlToRight))
 
 For Each Clls In Rng
   [B65500].End(xlUp).Offset(1).Value = Clls.Value
   Set sRng = pRng.Find(Clls.Value, , xlFormulas, xlWhole)
   If Not sRng Is Nothing Then
      sRng.Font.ColorIndex = 3
      For Each Cll1 In kRng
         Set Rngs = fRng.Find(Cll1.Value)
         If Not Rngs Is Nothing Then
            Cll1.Interior.ColorIndex = 36
            Cells([B65500].End(xlUp).Row, Cll1.Column).Value = _
                  Sh0.Cells(sRng.Row, Rngs.Column).Value
         End If
      Next Cll1
   End If
 Next Clls
 
 Set Sh = Sheets("Normal")                 
 Set pRng = Sh.Range(Sh.[d1], Sh.[d1].End(xlDown))
 Set Rng = Range([b2], [b2].End(xlDown))
 Set fRng = Sh.Range(Sh.[e1], Sh.[e1].End(xlToRight))
 For Each Clls In Rng
   Set sRng = pRng.Find(Clls.Value)
   If Not sRng Is Nothing Then
      sRng.Font.ColorIndex = 3
      For Each Cll1 In kRng
         If Cll1.Interior.ColorIndex <> 36 Then
            Set Rngs = fRng.Find(Cll1.Value)
            If Not Rngs Is Nothing Then
               Rngs.Interior.ColorIndex = 39
               Cells(Clls.Row, Cll1.Column).Value = _
                      Sh.Cells(sRng.Row, Rngs.Column).Value
            End If
         End If
      Next Cll1
   End If
 Next Clls
End Sub

(Bạn kiểm tra lại các số liệu trong 'KQua' xem sao!?)
 

File đính kèm

Lần chỉnh sửa cuối:
Công nhận bác siêng thật. Em mở file lên thấy có mấy cột trong Sheet Ketqua tìm hoài không thấy bên 2 Sheet nguồn. Thì ra là viết tắt nên tên cột đâu có giống nhau. Nản...
 
Cám ơn bạn SA_DQ !

Cám ơn bạn đã giúp, mình sẽ xem lại để làm tiếp tại còn rất nhiều mã như vậy, có gì bạn sẽ chỉ mình nhé.
 
khi mình mở file mới tải về và chạy macro, thì nó sẽ tạo ra 1 sheet mới;

Các tên cột cần lấy em tô màu xanh dương trong file đính kèm sau, (1)
Các mã cần tìm là tô màu xanh lá, và trong sheet KQua_Vidu là kết quả ví dụ khi chạy nó sẽ lấy được.

Còn các mã cần lấy đầy đủ nằm trong sheet danhsach, các cột cần lấy cũng mang tên như trong file trên. giá trị cần lấy thì trong sheet Cell data peak; (2)

Nếu trong tên cột có chữ Normal hoặc (N) thì lấy trong sheet Cell data Normal.

Có gì không hiểu thì cho mình hay liền, nhớ giúp mình, số điện thoại của mình: 01699.122.221, có gì nhắn tin cho mình hay mình sẽ điện lại cho, sẽ nói rõ hơn.(3)
Những cái sai của bạn:

(1) Tại trang 'KQua' bạn đưa ra 24 trường (cột) cần dữ liệu
Nhưng chỉ có 9 trường có tên trùng trong hoặc 'Normal' hay trong 'Peak'
(Các trường còn lại sẽ không biết lấy dữ liệu từ đâu?)
Yêu cầu là 24 tên trường này phải trùng với tên trường trong 'Peak' hay 'Normal'

(2) Nếu 1 trường nào đó của 'KQua' có cả trong 'Peak' & trong 'Normal' thì ưu tiên lấy trong 'Peak' ?

(3) Theo mình bạn không nên để số điện thoại của bạn mà nên để địa chỉ thư điện tử của mình; Nếu người ta cần đến bạn thì bạn hãy iêu cầu/đề nghị người ta gọi. Còn đây thì . . . . (Hơi thiếu tế nhị đó!) :-=

Biếu bạn macro tìm trường trùng tên, lúc nào rỗi tham khảo nha.:
PHP:
Option Explicit
Sub TrungTruong()
 Dim Rng As Range, Sh As Worksheet, Clls As Range, NRng As Range, sRng As Range
 
 Sheets("KQua").Select:                Set Sh = Sheets("Normal")
 Set Rng = Range([B1], [B1].End(xlToRight))
 Set NRng = Sh.Range(Sh.[a1], Sh.[a1].End(xlToRight))
 For Each Clls In Rng
   Set sRng = NRng.Find(Clls.Value, , xlFormulas, xlWhole)
   If Not sRng Is Nothing Then
      sRng.Interior.ColorIndex = 39:         Clls.Interior.ColorIndex = 39
   End If
 Next Clls
End Sub
 
Lần chỉnh sửa cuối:
Xin hướng dẫn thêm !

- Bạn ơi giờ mình đã sửa lại các tên trường đúng hết, nhưng có cột có ở 2 sheet Normal và Peak, một sẽ lấy ở Normal và một sẽ lấy ở Peak, như cột K và U, T và V, thì K sẽ lấy ở sheet normal, U lấy ở sheet Peak, giờ thì nó trùng giá trị rùi, Bạn chỉ mình cách cho 1 lấy ở Normal và 1 lấy ở Peak.
- Hôm trước mình đã sai, bạn cho mình địa chỉ mail hoặc nick chat được không, mình chưa hiểu giải thuật của các câu lệnh này, hay bạn có thể chú thích cho mình các dòng lệnh để mình hiểu giải thuật cho các lần làm sau này.
- Nhưng hôm trước em có nói, hằng ngày mình sẽ tải một file mới về có các sheet normal và peak, nếu làm như file excel ở trên thì phải thêm copy các sheet ở file mới tải đó paste vào 2 sheet tương ứng, như vậy cũng không hay cho việc sử dụng macro. Ý em là chuyển nó thành add-in (*.xla, nhưng em làm chưa được) để mình mở file vừa tải xuống thì sẽ có sẵng macro này trong đó, khi chạy nó sẽ tạo ra một sheet mới để chứa dữ liệu cũng trên file đó, không còn dò tìm giá trị trong sheet danhsach nữa. mình sẽ thêm 1 dòng ở cuối cùng của các giá trị tìm được, tính giá trị trung bình của từng cột đó.
Như vậy mình có làm được không anh. Nếu được thì giúp mình, mình cám ơn.
 
(1) - Bạn ơi giờ mình đã sửa lại các tên trường đúng hết, nhưng có cột có ở 2 sheet Normal và Peak, một sẽ lấy ở Normal và một sẽ lấy ở Peak, như cột K và U, T và V, thì K sẽ lấy ở sheet normal, U lấy ở sheet Peak, giờ thì nó trùng giá trị rùi, Bạn chỉ mình cách cho 1 lấy ở Normal và 1 lấy ở Peak.

(3)- Mình chưa hiểu giải thuật của các câu lệnh này, hay bạn có thể chú thích cho mình các dòng lệnh để mình hiểu giải thuật cho các lần làm sau này.

(2)- Nhưng hôm trước em có nói, hằng ngày mình sẽ tải một file mới về có các sheet normal và peak, nếu làm như file excel ở trên thì phải thêm copy các sheet ở file mới tải đó paste vào 2 sheet tương ứng, như vậy cũng không hay cho việc sử dụng macro.
(1) Chưa thấy bạn đưa lên các trường trong danh sách;
Nếu các trường trong 'DSach' là bất di bất dịch thì ta dùng 2 màu nền để phân biết cần chép từ đâu, 'Peak' hay 'Normal'

(2) Việc bây giờ là hoàn chỉnh cái macro cho file cái đã; Sau đó mới nói đến chuyện nó cần bố trí ở đâu;

(3) Giải thích vài dòng lệnh, như sau

PHP:
Option Explicit 
Sub TongHop() 
1 Const N1 As String = "Normal":           Const N2 As String = "N)" 
 Dim Sh As Worksheet, Sh0 As Worksheet 
 Dim Rng As Range, Clls As Range, pRng As Range, sRng As Range 
 Dim Cll1 As Range, kRng As Range, fRng As Range, Rngs As Range 
 Dim eRw As Long 
  
2 Sheets("KQua").Select:                   Set Sh = Sheets("DSach") 
 eRw = [B65500].End(xlUp).Row:            Set Sh0 = Sheets("Peak") 
4 If eRw > 1 Then Range("B2:iV" & eRw).ClearContents 
 Set Rng = Sh.[b2].CurrentRegion 
6 Set pRng = Sh0.Range(Sh0.[d1], Sh0.[d1].End(xlDown)) 
 Set kRng = Range([c1], [c1].End(xlToRight)) 
8 Set fRng = Sh0.Range(Sh0.[e1], Sh0.[e1].End(xlToRight)) 
  
 For Each Clls In Rng 
10   [B65500].End(xlUp).Offset(1).Value = Clls.Value 
   Set sRng = pRng.Find(Clls.Value, , xlFormulas, xlWhole) 
12   If Not sRng Is Nothing Then 
      sRng.Font.ColorIndex = 3 
14      For Each Cll1 In kRng 
         Set Rngs = fRng.Find(Cll1.Value) 
16         If Not Rngs Is Nothing Then 
            Cll1.Interior.ColorIndex = 36 
18            Cells([B65500].End(xlUp).Row, Cll1.Column).Value = _ 
                  Sh0.Cells(sRng.Row, Rngs.Column).Value 
         End If 
20      Next Cll1 
   End If 
22  Next Clls 
' . . . '
Từ dòng 1 đến trước dòng 2: Khai báo các biến cần dùng;
2: Phần đầu: Kích hoạt trang tính 'KQua';
Phần sau: Gán trang tính 'DSach' vô biến đối tượng đã khai báo;
3: Phần đầu: Xác định dòng cuối của trang tính đã kích hoạt;
Phần sau: Giống với câu lệnh sau của 2, nhưng với 'Peak';
4: Nếu 'KQua' có dữ liệu thì xóa chúng đi (để lại tiêu đề);
5: Gán vùng các tên trường của DSach vô biến Rng
6: Gán dữ liệu thuộc trường (cột) BTS_Name của 'Peak' vô biến pRng đã khai báo;
7: Gán vùng thuộc dòng 1 của 'KQua' bắt đầu từ cột 'C' cho đến hết vô biến kRng;
8: Tương tự như dòng lệnh 7, nhưng với 'Peak' => fRng
9: Tạo vòng lặp với từng ô lần lượt trong biến Rng (Cho đến dòng lệnh 22);
10: Chép giá trị trong các ô của Rng vô cột 'B' của trang tính hiện hành
11: Tìm giá trị từng ô này trong vùng pRng
12: Nếu tìm thấy ô cùng trị với trị cần tìm thì thực hiện các lệnh từ dòng 13 đến dòng 21
13: Tô Font của ô tìm thấy thành màu đỏ
14: Tạo vòng lặp xuyên suốt các ô trong biến kRng (Xem dòng 7 để rõ về kRng);
15: Tìm giá trị từng ô của vòng lặp có trong biến fRng
16: Nếu tìm thấy trị trùng nhau thì thực hiện 2 lệnh tiếp theo;
17: Ô chứa trị đem đi tìm được tô màu nền (chỉ số là 36 - màu tím nhạt)
18: (Câu lệnh quan trọng nhứt của các câu) Trị chứa trong 'Peak' thuộc hàng là hàng của ô được tìm thấy của lần tìm thứ nhất ( dòng lệnh 11), & cột là cột của ô được tìm thấy của lần tìm thứ 2 (dòng lệnh 15) được đem gán vô ô cuối của cột 'B' thuộc trang tính hiện hành (Trang tính đang kích hoạt cũng là nó)

Các dòng còn lại dùng để kết thúc If hay kết thúc vòng lặp

Bạn phải hiểu hết các dòng lệnh này, chúng ta mới tiếp được!
 
Chỉnh sửa lần cuối bởi điều hành viên:
Macro lấy dữ liệu chưa xong được !

- Giờ thì mình đã chỉnh theo ý bạn là các tên cột lấy giá trị ở sheet Peak là màu đỏ, Normal là màu xanh (file đính kèm), các tên cột này là cố định, macro này giờ chỉ thêm phần tính giá trị trung bình của mỗi cột tương ứng với dãy màu vàng mình tô, với khi chạy file mới nó cũng load macro thành add-in của mình lên (không cần paste sheet normal và peak từ file mới tải về) để chạy luôn trên file mới đó chép lên một sheet mới là hoàn thiện rồi, giờ thì chuyển thành add-in nó không hiểu vì các mã HUG0011 nó phải lấy từ sheet "danhsach".
- Nói thật, mình không hiểu giải thuật, nhưng cám ơn bạn đã hết lòng chỉ dẫn, mình sẽ học để tiến bộ, nhưng nó mới nên mình làm chưa nổi, nhờ bạn giúp cho mình, mình đang rất cần nó trong công việc.
- Cũng vì rất cần nên mấy bữa trước mình có đưa lên số ĐT, đã bị "phê bình" rùi, nhưng do mình cần quá nên chịu thôi. Thân !
 
Lần chỉnh sửa cuối:
Bạn chép macro này đè lên cái cũ, cho chạy & kiểm tra số liệu do macro tạo ra

Chú ý: Mình đã chuyển các trường nền màu đỏ (3) sang tím nhạt (38) & 2 trường màu xanh sẫm (10) sang màu lơ (35) ( 38 & 35)

PHP:
Option Explicit
Sub TongHop()
 Dim Sh As Worksheet, Shp As Worksheet
 Dim Rng As Range, Clls As Range, pRng As Range, sRng As Range
 Dim Cll1 As Range, kRng As Range, fRng As Range, Rngs As Range
 Dim eRw As Long
 
 Application.ScreenUpdating = False
 Sheets("KQua").Select:                   Set Sh = Sheets("DSach")
 eRw = [B65500].End(xlUp).Row:            Set Shp = Sheets("Peak")
 If eRw > 1 Then Range("B2:iV" & eRw).ClearContents
 Set Rng = Sh.[b2].CurrentRegion
 Set pRng = Shp.Range(Shp.[d1], Shp.[d1].End(xlDown))
 Set kRng = Range([c1], [c1].End(xlToRight))                      '<=|'
 Set fRng = Shp.Range(Shp.[e1], Shp.[e1].End(xlToRight))
1 'Chép Tu "Peak" Sang "KQua" '
 For Each Clls In Rng
   [B65500].End(xlUp).Offset(1).Value = Clls.Value 'Chep Cac Ma Tu "DSach" Vo "KQua" '
   Set sRng = pRng.Find(Clls.Value, , xlFormulas, xlWhole)
   If Not sRng Is Nothing Then
      sRng.Font.ColorIndex = 3
      For Each Cll1 In kRng
         If Cll1.Interior.ColorIndex = 38 Then 'Màu Tím'
            Set Rngs = fRng.Find(Cll1.Value)
            If Not Rngs Is Nothing Then
               Rngs.Interior.ColorIndex = 38
               Cells([B65500].End(xlUp).Row, Cll1.Column).Value = _
                  Shp.Cells(sRng.Row, Rngs.Column).Value
            End If
         End If
      Next Cll1
   End If
 Next Clls
2 'Chép Tu "Normal" Sang "KQua"'
 Set Sh = Sheets("Normal"):             Set pRng = Sh.Range(Sh.[d1], Sh.[d1].End(xlDown))
 Set Rng = Range([b2], [b2].End(xlDown))
 Set fRng = Sh.Range(Sh.[e1], Sh.[e1].End(xlToRight))
 For Each Clls In Rng
   Set sRng = pRng.Find(Clls.Value)
   If Not sRng Is Nothing Then
      sRng.Font.ColorIndex = 3
      For Each Cll1 In kRng
      
         If Cll1.Interior.ColorIndex <> 38 Then
            Set Rngs = fRng.Find(Cll1.Value)
            If Not Rngs Is Nothing Then
               Rngs.Interior.ColorIndex = 35
               Cells(Clls.Row, Cll1.Column).Value = Sh.Cells(sRng.Row, Rngs.Column).Value
            End If
         End If
         
      Next Cll1
   End If
 Next Clls
3 'Tính Trung Bình Các Côt Trong "KQua"'
 Set Rng = [B1].End(xlDown).Offset(1, 1)
 Rng.FormulaR1C1 = "=AVERAGE(R[-" & Rng.Row - 1 & "]C:R[-1]C)"
 eRw = [iV1].End(xlToLeft).Column
 Rng.AutoFill Destination:=Rng.Resize(, eRw - Rng.Column + 1), Type:=xlFillDefault
 
End Sub
 
Lần chỉnh sửa cuối:
Macro chưa xong !

Mình không thể đưa luôn nội dung của file "danhsach" vào trong code luôn hả bạn, như vậy khi chuyển thành add-in (từ macro này), mình sẽ mở file hằng ngày tải về chạy add-in thì nó sẽ chạy lấy dữ liệu từ 2 sheet normal và peak trên file mới luôn, dữ liệu lấy được sẽ chép lên 1 sheet mới cũng trên file đó. Làm như vậy mỗi ngày không cần phải copy 2 sheet normal và peak trên file mới tải về paste vào file daily này.
 
Để hiểu được bạn thật khó vô chừng luôn & sắp hết kiên nhẫn rồi!!

Mình không thể đưa luôn nội dung của file "danhsach" vào trong code luôn hả bạn, như vậy khi chuyển thành add-in (từ macro này), mình sẽ mở file hằng ngày tải về chạy add-in thì nó sẽ chạy lấy dữ liệu từ 2 sheet normal và peak trên file mới luôn, dữ liệu lấy được sẽ chép lên 1 sheet mới cũng trên file đó. Làm như vậy mỗi ngày không cần phải copy 2 sheet normal và peak trên file mới tải về paste vào file daily này.

- Nhưng hôm trước em có nói, hằng ngày mình sẽ tải một file mới về có các sheet normal và peak, nếu làm như file excel ở trên thì phải thêm copy các sheet ở file mới tải đó paste vào 2 sheet tương ứng, như vậy cũng không hay cho việc sử dụng macro. Ý em là chuyển nó thành add-in (*.xla, nhưng em làm chưa được) để mình mở file vừa tải xuống thì sẽ có sẵng macro này trong đó, khi chạy nó sẽ tạo ra một sheet mới để chứa dữ liệu cũng trên file đó, không còn dò tìm giá trị trong sheet danhsach nữa. mình sẽ thêm 1 dòng ở cuối cùng của các giá trị tìm được, tính giá trị trung bình của từng cột đó.
Như vậy mình có làm được không anh.

(1) Nếu phải biến macro này thành Add-In gì đó thì bạn tự ên đi!
Từ đơn giản đến phức tạp:

Bạn đến BOX mà mọi người thảo luận về vấn đề Add-In này &
Làm thử với macro nội dung sau:

PHP:
Sub LoiChaoMung()
  MsgBox "Xin Chao Ban", , "From GPE.COM"
End Sub

(2) Bạn phải nói nguyên câu, rành rọt, ví dụ:
Hàng ngày tôi phải tải 1 file dữ liệu từ chương trình khác vào file excel mới; Sau đó
chép bảng DanhSach vô file excel đó để xử lý . . .
(Hay bạn dụng tiếng Anh hoặc tiếng Nga đi, OK luôn & sẽ có người giúp chúng ta hiểu nhau hơn!)
 
Làm macro chưa xong !

Bạn ChanhTQ gì đó ơi, tôi nói thật, mấy hôm nay Tôi luôn theo dõi diễn đàn, tôi nhờ giúp vấn đề này, nếu bạn muốn giúp hết lòng bạn phải đọc hết những lời tôi trình bày từ đầu chủ đề, đúng không, lâu lâu bạn "chọt" vô câu làm người trong diễn đàn hiểu lầm tôi thì chết.
Ý tôi là giờ chỉ thêm những ý trên là được: tức là mình bổ sung code để chuyển thành add-in, khi đó mình tải file mà hằng ngày nó được thay đổi, add-in thì khi mờ ứng dụng excel lên thì sẽ load theo nó, nó sẽ thực hiện những việc mình yêu cầu theo như ở trên. Nếu mình làm như ở trên phải thêm 1 thao tác là copy sheet normal và peak ở file mới hằng ngày tải về paste vào file daily ở trên tôi có post theo đó (và không cần dùng đến sheet danhsach nữa). Tức là khi chạy macro sẽ chạy trên một file mới hoàn toàn (tức không phải file daily ở trên) là add-in nên mở ứng dụng excel nó tự nhiên sẽ được load theo, thực hiện việc ở trên yêu cầu, không cần dựa vào giá trị của sheet danhsach, và khi load trên file mới như vậy sẽ không cần copy dữ liệu các sheet normal và peak trên file mới tải về). Thân chào bạn !
 
Vài dòng chia sẻ.

Bạn ChanhTQ gì đó ơi, tôi nói thật, mấy hôm nay Tôi luôn theo dõi diễn đàn, tôi nhờ giúp vấn đề này, nếu bạn muốn giúp hết lòng bạn phải đọc hết những lời tôi trình bày từ đầu chủ đề, đúng không, lâu lâu bạn "chọt" vô câu làm người trong diễn đàn hiểu lầm tôi thì chết.
Ý tôi là giờ chỉ thêm những ý trên là được: tức là mình bổ sung code để chuyển thành add-in, khi đó mình tải file mà hằng ngày nó được thay đổi, add-in thì khi mờ ứng dụng excel lên thì sẽ load theo nó, nó sẽ thực hiện những việc mình yêu cầu theo như ở trên. Nếu mình làm như ở trên phải thêm 1 thao tác là copy sheet normal và peak ở file mới hằng ngày tải về paste vào file daily ở trên tôi có post theo đó (và không cần dùng đến sheet danhsach nữa). Tức là khi chạy macro sẽ chạy trên một file mới hoàn toàn (tức không phải file daily ở trên) là add-in nên mở ứng dụng excel nó tự nhiên sẽ được load theo, thực hiện việc ở trên yêu cầu, không cần dựa vào giá trị của sheet danhsach, và khi load trên file mới như vậy sẽ không cần copy dữ liệu các sheet normal và peak trên file mới tải về). Thân chào bạn !
Bạn có thấy là sau mỗi bài viết của bạn đều có người hỏi lại hoặc yêu cầu thêm gì đó không. Cái chính là khả năng trình bày của bạn chưa được tốt (Nói đâu xa, ngay cách xưng hô cũng thấy rồi. Xưng hô với cùng một người trong cùng một bài viết mà lúc thì "Tôi", lúc "Mình" lúc lại "Em". Rồi lúc "Anh", lúc "Bạn". Và bạn thật sự chưa chuẩn bị gì khi mang vấn đề này lên diễn đàn để hỏi. Người ta cần tới đâu bạn mới cung cấp thông tin tới đó. Có thể khi mang vấn đề lên đây hỏi, bạn cũng không đặt nhiều hy vọng mọi người ở đây có thể giúp được bạn.

Ở đây mọi người giúp nhau không vụ lợi. Vì vậy, dù bạn có gấp hay gì gì đi nữa thì đó là vấn đề của bạn. Ở đây sẽ không có chuyện ưu tiên cho người cần gấp đâu.
 
Chủ đề về macro cũ !

1. Xin chào và chúc sức khỏe các anh em trong GPE, mấy hôm nay bị diễn đàn "la" quá huê thiệt, cũng may là suy nghĩ lại ai mà không có những điểm yếu - mói mới dám quay lại diễn đàn, với phương châm lớn hơn nữa là có thất bại rùi mới gặt được thành công chứ, em có nghiên cứu code và kết hợp với việc Record macro để lấy code nhưng không thể làm được, quá dốt rồi, hôm nay đã trang trí file này gần hoàn thành, nhưng còn những cột nào tên có chữ Normal trong dấu ngoặc sẽ lấy dữ liệu trong sheet normal em chưa làm được (tức những tên cột được tô màu xanh là lấy trong sheet normal - những cột kia vậy là đúng rồi). Mong mấy anh em chịu vất vả chỉ giúp.
2. Mấy anh em có tài liệu về macro kèm theo bài tập để làm thử cho em xin. Em cám ơn nhiều lắm. Em thấy nó rất hay.
 
Lần chỉnh sửa cuối:
Nếu muốn có (Normal) thì có Normal

Nhưng chỉ đúng với file của bạn đính kèm lần cuối thôi đó nha:

PHP:
Option Explicit
Sub TongHop()
 Const N1 As String = "Normal":           Const N2 As String = "N)"
 Dim Sh As Worksheet, Sh0 As Worksheet
 Dim Rng As Range, Clls As Range, pRng As Range, sRng As Range
 Dim Cll1 As Range, kRng As Range, fRng As Range, Rngs As Range
5 Dim eRw As Long, VTri As Byte   '<=|'
 
 Sheets("KQua").Select:                   Set Sh = Sheets("DSach")
 eRw = [B65500].End(xlUp).Row:            Set Sh0 = Sheets("Peak")
 If eRw > 1 Then Range("B2:iV" & eRw).ClearContents
 Set Rng = Sh.[b2].CurrentRegion
 Set pRng = Sh0.Range(Sh0.[d1], Sh0.[d1].End(xlDown))
 Set kRng = Range([C1], [C1].End(xlToRight))
 Set fRng = Sh0.Range(Sh0.[e1], Sh0.[e1].End(xlToRight))
 
 For Each Clls In Rng
   [B65500].End(xlUp).Offset(1).Value = Clls.Value
   Set sRng = pRng.Find(Clls.Value, , xlFormulas, xlWhole)
   If Not sRng Is Nothing Then
      sRng.Font.ColorIndex = 3
      For Each Cll1 In kRng
         Set Rngs = fRng.Find(Cll1.Value)
         If Not Rngs Is Nothing Then
            Cll1.Interior.ColorIndex = 36
            Cells([B65500].End(xlUp).Row, Cll1.Column).Value = Sh0.Cells(sRng.Row, Rngs.Column).Value
         End If
      Next Cll1
   End If
 Next Clls
 
 Set Sh = Sheets("Normal"):                  Set pRng = Sh.Range(Sh.[d1], Sh.[d1].End(xlDown))
 Set Rng = Range([b2], [b2].End(xlDown))
 Set fRng = Sh.Range(Sh.[e1], Sh.[e1].End(xlToRight))
 For Each Clls In Rng
   Set sRng = pRng.Find(Clls.Value)
   If Not sRng Is Nothing Then
      sRng.Font.ColorIndex = 3
      For Each Cll1 In kRng
         If Cll1.Interior.ColorIndex <> 36 Then
36            VTri = InStr(Cll1.Value, N1) '<=|'
            Set Rngs = fRng.Find(Left(Cll1.Value, VTri - 3))  '<=|'
            If Not Rngs Is Nothing Then
               Rngs.Interior.ColorIndex = 39
               Cells(Clls.Row, Cll1.Column).Value = Sh.Cells(sRng.Row, Rngs.Column).Value
            End If
         End If
      Next Cll1
   End If
 Next Clls
End Sub

Chú í các dòng lệnh 5, 36 & 37
 
Macro chưa lấy được 2 cột !

Các cột em tô màu đỏ là chưa lấy được anh ơi, nó chỉ lấy được các cột màu xanh thôi. Anh giúp hộ em tí với. Em cám ơn.
 
Web KT

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

Back
Top Bottom