Chuyên mục xử lý, gỡ rối code VBA

ndu96081631 · 24/9/13

Topic Những câu hỏi về code, xin giải thích các code... đã quá dài nên mình đóng nó lại và mở topic khác
Tất cả những bài viết liên quan đến việc nhờ giải thích, xử lý và gỡ rối code VBA, các bạn vui lòng đăng tại đây!
Cảm ơn

TrungChinhs · 24/7/17

ndu96081631 đã viết:
Hình như phải vầy anh à
Application.SendKeys "%{Down}"

Vẫn không được em à. Hay là máy phải cài đặt, khai báo gì không ?

ndu96081631 · 24/7/17

TrungChinhs đã viết:
Vẫn không được em à. Hay là máy phải cài đặt, khai báo gì không ?

Em nghĩ vấn đề không ở code mà là ở cái Shape anh vẽ trên bảng tính. Anh thử thay nó bằng Button (Form Controls) xem sao

befaint · 24/7/17

TrungChinhs đã viết:
Vẫn không được em à. Hay là máy phải cài đặt, khai báo gì không ?

Em thấy hơi lạ khi anh bảo "cái cần không thấy".
Anh thử tải file ở bài #59 xem.
http://www.giaiphapexcel.com/dienda...ta-validation-excel.127658/page-3#post-801510

TrungChinhs · 24/7/17

ndu96081631 đã viết:
Em nghĩ vấn đề không ở code mà là ở cái Shape anh vẽ trên bảng tính. Anh thử thay nó bằng Button (Form Controls) xem sao

Chay bằng phìm f5 cungc vẫn không được

TrungChinhs · 24/7/17

befaint đã viết:
Em thấy hơi lạ khi anh bảo "cái cần không thấy".
Anh thử tải file ở bài #59 xem.
http://www.giaiphapexcel.com/diendan/threads/tìm-kiếm-trong-data-validation-excel.127658/page-3#post-801510

Ý mình là câu lệnh đó nó không có tác dụng trên màn hình. Trong bài không thấy nói về xử lý tình huống này.

befaint · 24/7/17

TrungChinhs đã viết:
Chay bằng phìm f5 cungc vẫn không được

SendKey thì cửa sổ nào đang active (hiện hành) thì nó send key tại cửa sổ đó.
Anh đang trong cửa sổ VBA mà nhấn F5 (Run) thì nó chạy dòng send key đó, tức là nhấn tổ hợp phím Alt + Arrow Down trong cửa sổ VBA. Khi đó thì đúng là anh chẳng thấy cái gì rồi.

befaint · 24/7/17

TrungChinhs đã viết:
Ý mình là câu lệnh đó nó không có tác dụng trên màn hình. Trong bài không thấy nói về xử lý tình huống này.

Thế thì anh chưa đọc hết topic đó rồi. Ngay bài #1 của topic đó có nói SendKey bị "mất phím Numlock". Không tin anh kiểm tra Numlock sau mỗi lần SendKey xem.

Theo bài #826 có gợi ý cho anh rồi. Do anh dùng shape để gán macro thì shape đó không giữ được setFocus tại cell hiện hành (không biết sau khi send key thì nó nhảy đi đâu, rồi mới về cell hiện hành).
Anh có thể thử nghiệm: Click chuột trái và giữ im vào cái shape đó xem. Sau khi nhả chuột thì thấy gì..

Anh không dùng shape để gán macro nữa, thử theo bài #826 đó anh.

nojustme · 26/7/17

Dạ em chào các anh chị,

Em có một bài toán chọn mẫu có điều kiện, muốn sử dụng code VBA để tự động giải quyết, nhưng chưa có nhiều kinh nghiệm.
nhờ anh chị định hướng giúp em với ạ.
1. Dữ liệu đầu vào
- Một sheet data nguồn "Data reference" có sẵn dùng để lấy thông tin
- Một bảng mã hàng bất kì sheet "Data cần lọc"
2. Dữ liệu đầu ra
- Chọn 10% mã hàng có trong list
Trong đó:
+ 7% rơi vào các mã hàng có tỉ lệ lỗi cao nhất
+ 3% rơi vào các mã hàng có tỉ lệ bốc mẫu cao nhất
+ mã hàng 7% và 3% ko trùng nhau
3. Bài toán ví dụ:
Data cần lọc có 40 mã hàng
=> chọn ra 4 mã hàng, trong đó
+ 3 mã hàng có tỉ lệ lỗi cao nhất (75%)
+ 1 mã hàng có tỉ lệ bốc mẫu cao nhất (25%)
4. Trợ giúp
Em muốn nhờ các bác chỉ giúp em macro làm tự động phần này với ạ.
Về concept là như vậy nhưng em vừa mới mò về VBA nên nhờ các anh chị định hướng giúp em về cách làm với ạ!

Em cám ơn mọi người rất nhiều!

VetMini · 26/7/17

nojustme đã viết:
Về concept là như vậy nhưng em vừa mới mò về VBA nên nhờ các anh chị định hướng giúp em về cách làm với ạ!

Còn xếp với còn xẹp!

Nếu còn xẹp chú ô lỳ cỏ rách thì phải dùng Excel 2016. Dùng Pivot Table và nối hai bảng với nhau qua key mã hàng. Lúc đó muốn lấy ra phần trăm gì tuỳ thích.

kukubod · 27/7/17

Hi mọi người,

Em không rành lắm về VBA, nhờ mọi người hỗ trợ giùm em trường hợp này:

Em sẽ tạo 1 usseform và nội dung usedform này sẽ là giá trị của ô A2:E2 .
Em muốn viết code để lưu dữ liệu các ô này vào 1 file mới tên là filetong , và mỗi khi bấm save sẽ lưu tiếp tục xuống các dòng tiếp theo.
Nếu dữ liệu ô B2 đã tồn tại trong filetong thì sẽ save đè nội dung A2:E2 vào file filetong luôn .

Mọi người vui lòng giúp đỡ giùm em đoạn code này với !!!

thangteo · 27/7/17

Em có một chút vấn đề về code, trong file em đính kèm (cả ảnh lẫn file rar). Nhờ mọi người và các thầy chỉnh giúp:
1. Khắc phục tình trạng thời gian khi chạy về 00:00 không bị trễ giây khi kết hợp với âm thanh báo hiệu ạ.
2. Khi ở thời gian nghỉ giữa hiệp, khi về đến 00:10 (tức còn 10s) thì âm thanh báo hiệu sẽ kêu ạ.
Cảm ơn ạ!

thangteo · 28/7/17

Nhờ mọi người bớt chút thời gian gỡ rối vấn đề em nêu ở trên với ạ.

tueyennhi · 29/7/17

Anh Bate ơi xem lại giúp em hình như có sự nhầm lẫn. Ví dụ ID 136457 ở nghỉ lẻ phần phép là 0.7 nhưng code không thấy cộng cái đó. Lý do vì cột ID có thể lặp lại, còn các loại nghỉ thì phải riêng rẽ không được cộng lẫn nhau.

tueyennhi · 31/7/17

PHP:

With Sheets("N")
R = .Range("AL60000").End(xlUp).Row
If R > 4 Then
    sArr = .Range("AL4:AL" & R).Resize(, 16).Value
    ReDim tArr(1 To UBound(sArr), 1 To 16)
        For i = 2 To UBound(sArr)
            If Not Dic.Exists(sArr(i, 1)) Then
                k = k + 1
                Dic.Item(sArr(i, 1)) = k
                tArr(k, 1) = sArr(i, 1)
            End If
            For j = 6 To 16
                If sArr(1, j) = "P" Then
                    tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
                ElseIf sArr(1, j) = "NC" Then
                    tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
                ElseIf sArr(1, j) = "N" Then
                    tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
                ElseIf sArr(1, j) = "BH" Then
                    tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
                ElseIf sArr(1, j) = "CN" Then
                    tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
                ElseIf sArr(1, j) = "M7" Then
                    tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
                ElseIf sArr(1, j) = "TM" Then
                    tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
                ElseIf sArr(1, j) = "KH" Then
                    tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
                ElseIf sArr(1, j) = "SP" Then
                    tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
                ElseIf sArr(1, j) = "DN" Then
                    tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
                ElseIf sArr(1, j) = "LT" Then
                    tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
                End If
             
            Next j
        Next i
     
    End If
    .Range("AM13").Resize(k, 6) = tArr
End With

Em viết lại ở phần đầu của module GPE, Sub Bate đã liệt kê được ID và các loại nghỉ riêng rẽ. Nhưng ở phần dưới chỗ code

PHP:

'Ngay nghi....................................................................
            If sArr(i, j) = "LT" Then
                dArr(k, 6) = dArr(k, 6) + 1
                    If Dic.Exists(sArr(i, 4)) Then dArr(k, 6) = dArr(k, 6) + tArr(Dic.Item(sArr(i, 1)), 16)

vẫn không thấy nó cộng, không biết sai ở đâu mong mọi người chỉ giúp. số 16 số thứ tự của cột LT.

tueyennhi · 31/7/17

Em giả lập một file lên đây, anh chị tạo giúp em sử dụng Dic như thế nào để ra kết quả như vùng đổ màu vàng ở sheet KQ nhé. Em cảm ơn ạ!

thangteo · 31/7/17

Rất mong mọi người vào giúp đỡ ạ.

Ba Tê · 31/7/17

tueyennhi đã viết:

PHP:

With Sheets("N")
R = .Range("AL60000").End(xlUp).Row
If R > 4 Then
    sArr = .Range("AL4:AL" & R).Resize(, 16).Value
    ReDim tArr(1 To UBound(sArr), 1 To 16)
        For i = 2 To UBound(sArr)
            If Not Dic.Exists(sArr(i, 1)) Then
                k = k + 1
                Dic.Item(sArr(i, 1)) = k
                tArr(k, 1) = sArr(i, 1)
            End If
            For j = 6 To 16
                If sArr(1, j) = "P" Then
                    tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
                ElseIf sArr(1, j) = "NC" Then
                    tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
                ElseIf sArr(1, j) = "N" Then
                    tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
                ElseIf sArr(1, j) = "BH" Then
                    tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
                ElseIf sArr(1, j) = "CN" Then
                    tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
                ElseIf sArr(1, j) = "M7" Then
                    tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
                ElseIf sArr(1, j) = "TM" Then
                    tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
                ElseIf sArr(1, j) = "KH" Then
                    tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
                ElseIf sArr(1, j) = "SP" Then
                    tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
                ElseIf sArr(1, j) = "DN" Then
                    tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
                ElseIf sArr(1, j) = "LT" Then
                    tArr(Dic.Item(sArr(i, 1)), j) = tArr(Dic.Item(sArr(i, 1)), j) + sArr(i, j)
                End If
           
            Next j
        Next i
   
    End If
    .Range("AM13").Resize(k, 6) = tArr
End With

Em viết lại ở phần đầu của module GPE, Sub Bate đã liệt kê được ID và các loại nghỉ riêng rẽ. Nhưng ở phần dưới chỗ code

PHP:

'Ngay nghi....................................................................
            If sArr(i, j) = "LT" Then
                dArr(k, 6) = dArr(k, 6) + 1
                    If Dic.Exists(sArr(i, 4)) Then dArr(k, 6) = dArr(k, 6) + tArr(Dic.Item(sArr(i, 1)), 16)

vẫn không thấy nó cộng, không biết sai ở đâu mong mọi người chỉ giúp. số 16 số thứ tự của cột LT.

Bạn đưa 1 file hồi "Chí Phèo ở truồng" rồi hỏi, ai mà biết file của bạn làm gì,.
Cột nào lấy từ đâu, cộng với cột nào lấy từ đâu?
Đọc lại từng dòng code để hiểu nó làm gì thì thà viết mới còn "sướng" hơn.
Bạn kiểm tra lại file này xem sao, nếu không đúng thì giải thích lại từ đầu, viết lại từ đầu.

tueyennhi đã viết:
Em giả lập một file lên đây, anh chị tạo giúp em sử dụng Dic như thế nào để ra kết quả như vùng đổ màu vàng ở sheet KQ nhé. Em cảm ơn ạ!

File "giả lập" của bạn mà áp dụng được vào file thật thì là "Siêu" luôn.

Ba Tê · 31/7/17

thangteo đã viết:
Rất mong mọi người vào giúp đỡ ạ.

"tueyennhi" hỏi, còn "thangteo" hối thúc là sao ta?

thangteo · 31/7/17

Ba Tê đã viết:
"tueyennhi" hỏi, còn "thangteo" hối thúc là sao ta?

Hix.. Em hỏi ở mấy # trước, rồi đến mấy # sau của anh gì đó cũng chưa có ai hồi âm giúp đỡ nên em hối vậy ạ. Hihi. Giúp em đi mấy anh ơi!!

tueyennhi · 31/7/17

Ba Tê đã viết:
Bạn đưa 1 file hồi "Chí Phèo ở truồng" rồi hỏi, ai mà biết file của bạn làm gì,.
Cột nào lấy từ đâu, cộng với cột nào lấy từ đâu?
Đọc lại từng dòng code để hiểu nó làm gì thì thà viết mới còn "sướng" hơn.
Bạn kiểm tra lại file này xem sao, nếu không đúng thì giải thích lại từ đầu, viết lại từ đầu.

File "giả lập" của bạn mà áp dụng được vào file thật thì là "Siêu" luôn.

PHP:

 If Dic.Exists(sArr(I, 4)) Then
            Rws = Dic.Item(sArr(I, 4))
            For J = 6 To 9
                If tArr(Rws, J) > 0 Then dArr(K, J) = tArr(Rws, J)
            Next J
            For J = 7 To 16
                If tArr(Rws, J) > 0 Then dArr(K, J + 1) = tArr(Rws, J)
            Next J
        End If

Vâng gần đúng rồi anh ơi.
Anh ơi đặt trường hợp các Selecct case cũng có kết quả thì sao ạ? Ví dụ ở Select Case P ra kết quả là 1 (bằng cách thử điền P vào cột K8) như vậy thì kết quả em cần là 1.7. Em thử viết lại là. Vì ở sheet nghỉ lẻ chỉ là nghỉ nửa buổi hay gì đó cần cộng thêm vào, còn cái chính trong sheet BCC nếu nghỉ nguyên ngày ví dụ Phép thì em điền P. Cái này Select case của anh đã tính đến. Nhưng nó không cộng tổng cùng với nghỉ lẻ mà nếu nghỉ lẻ thì sẽ chỉ lấy của nghỉ lẻ bỏ qua cái select case đã tính kia.
If tArr(Rws, J) > 0 Then dArr(K, J) =dArr(K, J)+ tArr(Rws, J) thì có đúng không?

Nếu đúng thì chỗ code:
If tArr(Rws, J) > 0 Then dArr(K, J + 1) = tArr(Rws, J) em phải sửa tiếp như nào ạ??.

Chuyên mục xử lý, gỡ rối code VBA

Huyền thoại GPE

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

File đính kèm

Huyền thoại GPE

|||||||||||||

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

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

|||||||||||||

|||||||||||||

Thành viên mới

File đính kèm

Ăn cùng góc phố

Thành viên mới

File đính kèm

Thành viên thường trực

File đính kèm

Thành viên thường trực

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

File đính kèm

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

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

File đính kèm

Thành viên thường trực

Cạo Rồi Khỏi Gội

File đính kèm

Cạo Rồi Khỏi Gội

Thành viên thường trực

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

Facebook

Group