Dùng hàm phân tích thông tin sản phẩm

  • Thread starter ultimatum
  • Ngày gửi
QDuc

QDuc

Cao cấp
3/6/06
254
18
18
Biển khơi
(2) Dạ, Em sẽ cố gắng,
(1) Em có 1 bài nữa về mảng_em có sẵn code hết rồi muốn nhờ các anh xem giúp để chỉnh lại chút xíu, em phải post trong chủ đề mới đúng k anh?
Nhấn để mở rộng...
(1) Nên là vậy!
(2) Mình sẽ gợi vài í, mong rằng sẽ thuận tiện cho công việc của bạn theo các bước sau

(*) Bước chuẩn bị:
Bạn lấy file ở bài #31 của bạn;
1. Sau đó đổi vài chục hàng của các loại hàng hóa đang nhiều nhất sang loại ít nhất, sao cho các loại hàng hóa nhiều giảm xuống chỉ còn 45-46 dòng gì đó là được.

2. Vô hiệu hóa tạm thời macro sự kiện kích hoạt trang tính 'Sheet 2'; Cách thức đơn giản nhất là cho các dấu nháy đơn vô đầu các dòng lệnh.

(*) Bước 1: Chuyển macro Sub Array_ hiện tại thành macro con của macro sự kiện (tác động lên ô trang tính)
Nhiệm vụ của bước này chỉ là chuyển các tham ôố trong macro Array_ cho thích hợp, thích ứng cho cả 3 lần gọi nó sau này
Nhưng hiện giờ ta chỉ thực hiện sao cho chỉ gọi nó lần đầu; Sau khi thực hiện nó vẫn đưa ra êết quả tại vùng hiện giờ (từ cột [O] trở về sau
1. Tạm thời vô hiệu hóa dòng lệnh trong macro sự kiện tại [G5], như sau
Mã: 
'  GPE Target, 48 '
2. Xác định & đánh dấu các dòng lệnh cần sửa: Vì sau này ta sẽ cần macro trở thành macro con này cho hiễn thị êết quả lên các vùng khác nhau tùy thuộc vô tham biến Targ mà ta cung cấp khi gọi nó;
(Hiện tại ta sẽ vẫn cho nó hiễn thị kết quả từ cột [O] trở về sau mà thôi; Rốt cuộc ta sẽ tính tiếp)
Bạn tham khảo cách gọi macro GPE để có cách truyền 2 tham biến cho thích hợp; Nói thêm rằng trong macro GPE ta có tùy chọn tham biến thứ hai, nếu không truyền từ macro mẹ/cha cho nó thì nó tự biết lấy cái tham số mặc định giao cho nó từ trước ra mà xài)

Rất mong rằng bước đầu bạn sã thành công!
Chúc thắng lợi!
 
  • Like
Reactions: ultimatum
Khóa học Quản trị dòng tiền
U

ultimatum

Guest
4/12/08
39
7
8
binhthuan
QDuc nói:
(1) Nên là vậy!
(2) Mình sẽ gợi vài í, mong rằng sẽ thuận tiện cho công việc của bạn theo các bước sau

(*) Bước chuẩn bị:
Bạn lấy file ở bài #31 của bạn;
1. Sau đó đổi vài chục hàng của các loại hàng hóa đang nhiều nhất sang loại ít nhất, sao cho các loại hàng hóa nhiều giảm xuống chỉ còn 45-46 dòng gì đó là được.

2. Vô hiệu hóa tạm thời macro sự kiện kích hoạt trang tính 'Sheet 2'; Cách thức đơn giản nhất là cho các dấu nháy đơn vô đầu các dòng lệnh.

(*) Bước 1: Chuyển macro Sub Array_ hiện tại thành macro con của macro sự kiện (tác động lên ô trang tính)
Nhiệm vụ của bước này chỉ là chuyển các tham ôố trong macro Array_ cho thích hợp, thích ứng cho cả 3 lần gọi nó sau này
Nhưng hiện giờ ta chỉ thực hiện sao cho chỉ gọi nó lần đầu; Sau khi thực hiện nó vẫn đưa ra êết quả tại vùng hiện giờ (từ cột [O] trở về sau
1. Tạm thời vô hiệu hóa dòng lệnh trong macro sự kiện tại [G5], như sau
Mã: 
'  GPE Target, 48 '
2. Xác định & đánh dấu các dòng lệnh cần sửa: Vì sau này ta sẽ cần macro trở thành macro con này cho hiễn thị êết quả lên các vùng khác nhau tùy thuộc vô tham biến Targ mà ta cung cấp khi gọi nó;
(Hiện tại ta sẽ vẫn cho nó hiễn thị kết quả từ cột [O] trở về sau mà thôi; Rốt cuộc ta sẽ tính tiếp)
Bạn tham khảo cách gọi macro GPE để có cách truyền 2 tham biến cho thích hợp; Nói thêm rằng trong macro GPE ta có tùy chọn tham biến thứ hai, nếu không truyền từ macro mẹ/cha cho nó thì nó tự biết lấy cái tham số mặc định giao cho nó từ trước ra mà xài)

Rất mong rằng bước đầu bạn sã thành công!
Chúc thắng lợi!
Nhấn để mở rộng...
Em xin chào các Anh,

Em đã trở lại và vẫn ngu dại như xưa, hjc hjc, Sau nhiều ngày ngâm cứu,thật sự bế tắc với mảng.

Em đang xem về mảng ở trang này, các anh xem giúp em cái này có đúng với phần em đang tìm không?
http://bugatino17.wordpress.com/2014/03/21/lam-viec-voi-mang-trong-vba/

Mong các anh gợi ý thêm giúp em với ạ
 
  • Like
Reactions: SA_DQ
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
569
100
43
66
HCM city
Sau khi trang bị cho mình những lí thuyết cơ bản như trên rồi, bạn thử đem áp dụng thực tiễn trên file xem sao;
Trong file mình gởi kèm, mình đã làm 1 nhánh rồi đó;
Bạn thử trãi nghiệm với 2 nhánh còn lại xem sao
 

Đính kèm

  • gpeArr.rar
    33 KB · Lượt xem: 102
  • Like
Reactions: ultimatum
U

ultimatum

Guest
4/12/08
39
7
8
binhthuan
SA_DQ nói:
Sau khi trang bị cho mình những lí thuyết cơ bản như trên rồi, bạn thử đem áp dụng thực tiễn trên file xem sao;
Trong file mình gởi kèm, mình đã làm 1 nhánh rồi đó;
Bạn thử trãi nghiệm với 2 nhánh còn lại xem sao
Nhấn để mở rộng...
Ối, phần Array cũng khai báo được Optional như code trước. hjc hjc. Anh QDuc có nhắc mà em không biết khai báo thế nào.
Em cảm ơn anh SA_DQ rất nhiều.
 
Sửa lần cuối:
  • Like
Reactions: HongViet
U

ultimatum

Guest
4/12/08
39
7
8
binhthuan
Em như muốn nhảy lên vì sung sướng anh SA_DQ ơi. file chạy rồi
PHP: 
Option Explicit
Private Sub Worksheet_Activate()
    Array_ [g5], 48
    Array_ [g55]
   Array_ [g80]
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [g5]) Is Nothing Then
'    GPE Target, 48 '
    Array_ Target, 48
ElseIf Not Intersect(Target, [g55]) Is Nothing Then
    Array_ Target
ElseIf Not Intersect(Target, [g80]) Is Nothing Then
    Array_ Target
End If
End Sub

Public Sub Array_(Targ As Range, Optional Dg As Long = 23)
Dim Arr(), KQ(), Dic As Object, Sh As Worksheet, sRg As Range, Rng As Range, rws As Long
Dim Tmp As String, I As Long, J As Long, W As Long
  Set Dic = CreateObject("Scripting.Dictionary")
  Sheets("Sheet 2").Select:                 Set Sh = Sheets("HHoa")
  Set Rng = Sh.Range(Sh.[F4], Sh.[F65500].End(xlUp))
    rws = Rng.Rows.Count
  Arr = Sh.Range(Sh.[c5], Sh.[c65000].End(xlUp)).Resize(, 13).Value
  ReDim KQ(1 To Dg, 1 To 5)         '*'
'  [o5:s55].ClearContents            '*'
  Targ.Offset(, 8).Resize(Dg, 5).ClearContents
  For I = 1 To UBound(Arr())
    Tmp = ""
    Set sRg = Rng.Find(Targ.Value, , xlFormulas, xlWhole)
    If Arr(I, 4) = sRg.Value Then  '**'
    'If Arr(I, 4) = [g5].Value Then  '**'
        Tmp = Arr(I, 1) & CStr(Arr(I, 10))
        If Not Dic.exists(Tmp) Then
            W = W + 1
            Dic.Add Tmp, W
            KQ(W, 1) = Arr(I, 1):           KQ(W, 2) = Arr(I, 2)
            KQ(W, 3) = Arr(I, 3):           KQ(W, 4) = Arr(I, 13)
            KQ(W, 5) = Arr(I, 10)
        Else
            KQ(Dic.Item(Tmp), 4) = KQ(Dic.Item(Tmp), 4) + Arr(I, 13)
        End If
    End If
  Next I
  If W Then Targ.Offset(, 8).Resize(W, 5).Value = KQ()        '[o5].Resize(W, 5).Value = KQ        '*'
'  Range([o5], [o5].End(xlDown)).Resize(, 5).Sort Key1:=Range("o6"), Key2:=Range("r6"), Header:=xlGuess
    Targ.Offset(, 8).Resize(Dg, 5).Sort Key1:=Range("o6"), Key2:=Range("r6"), Header:=xlGuess
  Set Dic = Nothing
End Sub
em làm luôn 3 group và đã chạy, anh xem lại giúp em code vậy ổn chưa nha.

>>> Sau khi em test có bị 1 lỗi như sau: Nếu tên nhóm hàng ở cột G mà mình đánh sai thì phần mềm sẽ báo lỗi và hiển thị sai ngay, Các Anh xem giúp em phải chỉnh code thế nào để khi mình đánh sai tên nhóm nào thì nhóm đó sẽ không hiển thị gì cả.
 
Sửa lần cuối:
  • Like
Reactions: HongViet
S

SA_DQ

Thành viên Cố vấn - Webketoan Mentors
29/6/05
569
100
43
66
HCM city
/(hông những bạn rất đang sung sướng, mà người hướng dẫn cho bạn cũng sướng bội fần do đạt được mục đích: Giao vô tay bạn 1 cần câu để câu VBA!

Nếu tên nhóm hàng ở cột G mà mình đánh sai thì phần mềm sẽ báo lỗi và hiển thị sai ngay, Các Anh xem giúp em phải chỉnh code thế nào để khi mình . . . .
Nhấn để mở rộng...

Chuyện này bạn cần tiếp tục tự làm với các hướng dẫn bãy lỗi như sau:

PHP: 
Public Sub Array_(..., ...)
Dim . . .
On Error Goto LoiCT
'. . . . .. Các Dòng lệnh
. . . .   của bạn'
Err_:    Exit Sub
LoiCT:
   Msgbox Error, , Err
  Resume Err_
End Sub

Sau khi ta biết tên lỗi mà hàm Error() đã báo & số thứ tự mã lỗi (Err)
Thì ta sẽ xử tiếp:
(*) Trường hợp 1: Nếu ta fát hiện ra lỗi ngay, thì bạn cần tìm cách khác fục
(*) Trường hợp 2 (fần nhiều) thì bạn cần biết thêm dòng lệnh đã gây ra lỗi;
Bằng cách sau:
Bạn đánh số vô các dòng lệnh theo kiểu
Mã: 
1 Dim Rng As Range, sRng as Range
2 Dim fAdd As String
  Dim J As Long, W As Byte
4 Set Rng=Sh.Range(Sh.[A9], Sh.[A8].End{xlDown))
'. . . . . .'
9 Set sRng=Rng.Find(Targ.Value)
   If sRng Is Nothing Then
      MsgBox "Nothing"
  Else
    . . . . .
  End If
. . . .
Err_:    Exit Sub
LoiCT:
   Msgbox Error, , Erl
  Resume Err_
End Sub

Hàm Erl trong VBA sẽ cho bạn biết dòng lệnh nào bị lỗi!

Nhưng bạn cần nhớ rằng, báo lá VBA báo vậy, chứ chưa chắc dòng đó bi lỗi, mà có thể 1 hay 1 vài dòng lệnh bên trên làm nó lỗi.

(Như ví dụ bên trên, Nếu nó không tìm thấy ô nào thỏa (Dòng lệnh 9) thì báo lỗi ở dòng dưới hơn, khi bạn dùng dòng lệnh tác động gì đó lên sRng hay cần đến sRng)
Bạn tiếp tục thử đi nha & chúc thành công trên bước đường chông gai!
 
  • Like
Reactions: ultimatum
HongViet

HongViet

Cao cấp
10/11/05
286
10
18
Đà nẵng
Căn cứ vô bài #44 của bạn, ta có thể thấy trước mắt các lỗi có thể sẩy ra ở những chổ như sau:
Với macro kích hoạt trang tính:
Mã: 
Private Sub Worksheet_Activate()
  Array_ [g5], 48
  Array_ [g55]
  Array_ [g80]
End Sub
Ở macro này có thể lỗi 1 khi 1 hay cả 3 ô [G5], [G55] & [G80] vì 1 lí do nào đó trước đó
(1) Đã bị làm rỗng (Không chứa trị),
(2) Chứa trị nhưng không có trong cột mã hiệu của hàng hóa nơi bạn đang có

Ở trường hợp (1), ta cần 1 câu lệnh điều kiện If như
Mã: 
 If [G5].Value<> "" Then Array_ [G5], 48
là được rồi;

(2) Ở trường hợp sau thì ta lại fải bãy lỗi trong macro
PHP: 
Public Sub Array_(Targ As Range, Optional Dg As Long = 23)

End Sub
Mà cụ thể là ở câu lệnh tạo vòng lặp để duyệt tìm mã hàng.

PHP: 
    For I = 1 To UBound(Arr())

    Next I

Bạn thử sức mình đi nha & chúc thành công như lần trên bạn đã!
 
  • Like
Reactions: ultimatum
U

ultimatum

Guest
4/12/08
39
7
8
binhthuan
Cảm ơn các Anh rất nhiều.
Anh HongViet phân tích rất chính xác, vì em phải làm xong 1 dự án thì mới list ra các nhãn hiệu. Trên form hiện tại thì em để chữ " Other" vào chổ chưa có nhãn hiệu.

Sẽ cố gắng trở lại với các anh sớm. hjhjhj
 
  • Like
Reactions: SA_DQ
U

ultimatum

Guest
4/12/08
39
7
8
binhthuan
Woa woa woa, ra rồi các anh trai ơi. Đây là giải pháp cho trường hợp (2).
PHP: 
Option Explicit
Private Sub Worksheet_Activate()
    Array_ [g5], 48
    Array_ [g55]
   Array_ [g80]
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [g5]) Is Nothing Then
'    GPE Target, 48 '
    Array_ Target, 48
ElseIf Not Intersect(Target, [g55]) Is Nothing Then
    Array_ Target
ElseIf Not Intersect(Target, [g80]) Is Nothing Then
    Array_ Target
End If
End Sub

Public Sub Array_(Targ As Range, Optional Dg As Long = 23)
Dim Arr(), KQ(), Dic As Object, Sh As Worksheet, sRg As Range, Rng As Range, rws As Long
Dim Tmp As String, I As Long, J As Long, W As Long
  Set Dic = CreateObject("Scripting.Dictionary")
  Sheets("Sheet 2").Select:                 Set Sh = Sheets("HHoa")
  Set Rng = Sh.Range(Sh.[F4], Sh.[F65500].End(xlUp))
    rws = Rng.Rows.Count
  Arr = Sh.Range(Sh.[c5], Sh.[c65000].End(xlUp)).Resize(, 13).Value
  ReDim KQ(1 To Dg, 1 To 5)         '*'
'  [o5:s55].ClearContents            '*'
  Targ.Offset(, 8).Resize(Dg, 5).ClearContents
  For I = 1 To UBound(Arr())
    Tmp = ""
    'if not
    Set sRg = Rng.Find(Targ.Value, , xlFormulas, xlWhole)
    If Not sRg Is Nothing Then
    If Arr(I, 4) = sRg.Value Then  '**'
    'If Arr(I, 4) = [g5].Value Then  '**'
        Tmp = Arr(I, 1) & CStr(Arr(I, 10))
        If Not Dic.exists(Tmp) Then
            W = W + 1
            Dic.Add Tmp, W
            KQ(W, 1) = Arr(I, 1):           KQ(W, 2) = Arr(I, 2)
            KQ(W, 3) = Arr(I, 3):           KQ(W, 4) = Arr(I, 13)
            KQ(W, 5) = Arr(I, 10)
        Else
            KQ(Dic.Item(Tmp), 4) = KQ(Dic.Item(Tmp), 4) + Arr(I, 13)
        End If
    End If
    Else
    End If
    'msgbox
  Next I
  If W Then Targ.Offset(, 8).Resize(W, 5).Value = KQ()        '[o5].Resize(W, 5).Value = KQ        '*'
'  Range([o5], [o5].End(xlDown)).Resize(, 5).Sort Key1:=Range("o6"), Key2:=Range("r6"), Header:=xlGuess
    Targ.Offset(, 8).Resize(Dg, 5).Sort Key1:=Range("o6"), Key2:=Range("r6"), Header:=xlGuess
  Set Dic = Nothing
End Sub

nhờ các anh xem lại giúp em ạ.
 
QDuc

QDuc

Cao cấp
3/6/06
254
18
18
Biển khơi
Bạn đối chiếu & so sánh với macro này để thấy bạn còn "dư" vài câu lệnh hay không:
PHP: 
Public Sub Array_(Targ As Range, Optional Dg As Long = 23)
Dim Arr(), KQ(), Dic As Object, Sh As Worksheet
Dim Tmp As String, I As Long, J As Long, W As Long
  Set Dic = CreateObject("Scripting.Dictionary")
  Sheets("Sheet 2").Select:  Set Sh = Sheets("HHoa")
  Arr = Sh.Range(Sh.[c5], Sh.[c65000].End(xlUp)).Resize(, 13).Value
  ReDim KQ(1 To Dg, 1 To 5)  '*'
  Targ.Offset(, 8).Resize(Dg, 5).ClearContents
  For I = 1 To UBound(Arr())
  Tmp = ""
  If Arr(I, 4) = [g5].Value Then  '**'
  Tmp = Arr(I, 1) & CStr(Arr(I, 10))
  If Not Dic.exists(Tmp) Then
  W = W + 1
  Dic.Add Tmp, W
  KQ(W, 1) = Arr(I, 1):  KQ(W, 2) = Arr(I, 2)
  KQ(W, 3) = Arr(I, 3):  KQ(W, 4) = Arr(I, 13)
  KQ(W, 5) = Arr(I, 10)
  Else
  KQ(Dic.Item(Tmp), 4) = KQ(Dic.Item(Tmp), 4) + Arr(I, 13)
  End If
  End If
  Next I
  If W Then Targ.Offset(, 8).Resize(W, 5).Value = KQ()  '[o5].Resize(W, 5).Value = KQ  '*''
  Targ.Offset(, 8).Resize(Dg, 5).Sort Key1:=Range("o6"), Key2:=Range("r6"), Header:=xlGuess
  Set Dic = Nothing
End Sub
 
  • Like
Reactions: ultimatum
U

ultimatum

Guest
4/12/08
39
7
8
binhthuan
Xin chào các Anh,

Em đã đưa code này vào form của em và làm thử 1 dự án với Sheet "HHoa" khoảng 2000 Row, Nhóm 1 e tăng lên 120 Row, thì thấy thế này:
- Code này khi tính vẫn mất nhiều thời gian hơn 1P cho 54 Row nhóm 1.
- Nếu ta dùng Find để tìm thì ko khả thi, vì trong Form của em dùng công thức nó ko find được, phải Paste Scpecial cột F mới chạy được

Mong các anh chỉ dạy em cách "câu" tiếp ạ.
 
U

ultimatum

Guest
4/12/08
39
7
8
binhthuan
QDuc nói:
Bạn đối chiếu & so sánh với macro này để thấy bạn còn "dư" vài câu lệnh hay không:
PHP: 
Public Sub Array_(Targ As Range, Optional Dg As Long = 23)
Dim Arr(), KQ(), Dic As Object, Sh As Worksheet
Dim Tmp As String, I As Long, J As Long, W As Long
  Set Dic = CreateObject("Scripting.Dictionary")
  Sheets("Sheet 2").Select:  Set Sh = Sheets("HHoa")
  Arr = Sh.Range(Sh.[c5], Sh.[c65000].End(xlUp)).Resize(, 13).Value
  ReDim KQ(1 To Dg, 1 To 5)  '*'
  Targ.Offset(, 8).Resize(Dg, 5).ClearContents
  For I = 1 To UBound(Arr())
  Tmp = ""
  If Arr(I, 4) = [g5].Value Then  '**'
  .
.
.
.
  Set Dic = Nothing
End Sub
Nhấn để mở rộng...
Hình như em chỉ dư câu này thôi anh, mấy cái kia em sử dụng vào trong Code hết.
PHP: 
rws = Rng.Rows.Count
 
Bạn phải đăng nhập hoặc đăng ký để bình luận.

Similar threads

HaiTam
10 hàm excel mà kế toán hay dùng
Trả lời
3
Lượt xem
33K
FAQ - Hỏi đáp về Tin học
minhuv
M
S
Lọc danh sách sinh nhật theo quý nhơ hàm tự tạo
Trả lời
1
Lượt xem
29K
FAQ - Hỏi đáp về Tin học
SA_DQ
S
S
Dùng VBA để đánh số phiếu tự động thay vì áp dụng công thức
Trả lời
0
Lượt xem
33K
FAQ - Hỏi đáp về Tin học
SA_DQ
S
thinhphat1
Bán Màn hình máy tính DELL D2020H 19.5 icnh giá tốt
Trả lời
0
Lượt xem
14
Quảng cáo, rao vặt
thinhphat1
thinhphat1
HaiTam
BI – Business Intelligence
Trả lời
0
Lượt xem
27K
FAQ - Hỏi đáp về Tin học
HaiTam
HaiTam

Xem nhiều

Liên kết

Dịch vụ kế toán Tâm An kế toán quản trị

Chia sẻ trang

Share this page
Webketoan Zalo OA
Top Bottom