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

Status
Không mở trả lời sau này.

Sunbinsuzin

Thành viên mới
Tham gia ngày
8 Tháng sáu 2018
Bài viết
23
Được thích
0
Điểm
13
Tuổi
28
Em nhờ các bác sửa lại code dò tìm 6 điều kiện hộ em với ạ vì em viết nó chạy chậm quá ạ :D
Function TK6DK(DK1, DK2, DK3, DK4, DK5, DK6 As Variant, _
VUNGDK1, VUNGDK2, VUNGDK3, VUNGDK4, VUNGDK5, VUNGDK6, VUNGKQ As Range)
Dim I As Integer, iCount As Integer
iCount = VUNGDK1.Rows.Count
For I = 1 To iCount
If UCase(VUNGDK1.Cells(I, 1)) + UCase(VUNGDK2.Cells(I, 1)) = UCase(DK1) + UCase(DK2) Then
If UCase(VUNGDK3.Cells(I, 1)) = UCase(DK3) Then
If UCase(VUNGDK4.Cells(I, 1)) = UCase(DK4) Then
If UCase(VUNGDK5.Cells(I, 1)) = UCase(DK5) Then
If UCase(VUNGDK6.Cells(I, 1)) = UCase(DK6) Then
TK6DK = VUNGKQ.Cells(I, 1)
Exit For
End If
End If
End If
End If
End If
Next I
End Function
 

AutoReply

Thành viên tiêu biểu
Tham gia ngày
18 Tháng hai 2016
Bài viết
496
Được thích
632
Điểm
335
Ai lại đi nhìn ảnh? Ảnh thế nhưng lúc quên vẫn khà khà khà như thường.
Ấy sao lại là quên vậy bạn ? Người ta đâu có ý định "diễn" đâu bạn. Chỉ là ai gọi bằng gì cũng trả lời, miễn đừng kêu bằng thằng/con quỷ cái là được rồi.
 

batman1

Thành viên gắn bó
Tham gia ngày
8 Tháng chín 2014
Bài viết
2,202
Được thích
3,415
Điểm
560
Ấy sao lại là quên vậy bạn ? Người ta đâu có ý định "diễn" đâu bạn. Chỉ là ai gọi bằng gì cũng trả lời, miễn đừng kêu bằng thằng/con quỷ cái là được rồi.
Cái đó là viết về "nguyên tắc" chung, không nói cụ thể ảnh của ai. Chả nhẽ nhìn ảnh đứa bé đang bò thì lại viết "bé làm thế là sẽ có lỗi nhé"?
 

jialink

Thành viên mới
Tham gia ngày
16 Tháng mười một 2008
Bài viết
13
Được thích
1
Điểm
353
Tuổi
32
Nhờ mọi người gỡ rối cho mình đoạn code này với:
Sub Macro1()
For x = 1 To 2
Selection.EntireRow.Insert
Selection.EntireRow.Insert
SendKeys "{down}"
SendKeys "{down}"
SendKeys "{down}"
Next x

End Sub
Mình muốn đặt chuột ở cell A2 rồi chạy code để tự động insert thêm 2 hàng, sau đó tự động trỏ xuống 3 hàng và thực hiện lại...
Nhưng khi mình dùng code trên thì SendKeys "{down}" lại được thực hiện riêng với Selection.EntireRow.Insert
Mình có gửi kèm file
MONG MỌI NGƯỜI GIÚP ĐỠ, CẢM ƠN NHIỀU NHÉ!!!!!!!!!!!
 

File đính kèm

SA_DQ

/(hông là gì!
Thành viên danh dự
Tham gia ngày
8 Tháng sáu 2006
Bài viết
6,102
Được thích
10,120
Điểm
1,860
Em nhờ các bác sửa lại code dò tìm 6 điều kiện hộ em với ạ vì em viết nó chạy chậm quá ạ :D
Function TK6DK(DK1, DK2, DK3, DK4, DK5, DK6 As Variant, _
VUNGDK1, VUNGDK2, VUNGDK3, VUNGDK4, VUNGDK5, VUNGDK6, VUNGKQ As Range)
' . . . . . . . . '
End Function
Kiểu này nên có file thì may ra có đáp án cho bạn.
 

giaiphap

Thành viên gạo cội
Tham gia ngày
12 Tháng ba 2007
Bài viết
4,760
Được thích
3,989
Điểm
860
Nhờ mọi người gỡ rối cho mình đoạn code này với:
Sub Macro1()
For x = 1 To 2
Selection.EntireRow.Insert
Selection.EntireRow.Insert
SendKeys "{down}"
SendKeys "{down}"
SendKeys "{down}"
Next x

End Sub
Mình muốn đặt chuột ở cell A2 rồi chạy code để tự động insert thêm 2 hàng, sau đó tự động trỏ xuống 3 hàng và thực hiện lại...
Nhưng khi mình dùng code trên thì SendKeys "{down}" lại được thực hiện riêng với Selection.EntireRow.Insert
Mình có gửi kèm file
MONG MỌI NGƯỜI GIÚP ĐỠ, CẢM ƠN NHIỀU NHÉ!!!!!!!!!!!
Tốt nhất bạn nên mô tả kỷ lại vấn đề và sẽ tốt hơn nửa là nên có thêm sheet trước khi chạy code và sheet sau khi chạy code.
 

truongvu317

Thành viên tiêu biểu
Tham gia ngày
15 Tháng mười một 2010
Bài viết
449
Được thích
348
Điểm
410
Xinh đẹp thì có thể, nhưng bạn gái thì chưa chắc.
Ảnh thế nhưng lúc quên vẫn khà khà khà như thường.
Xin nhận khuyết điểm là em quá ngây thơ khi nhìn ảnh.


Cái hàm bạn muốn viết nó tính toán cái gì vậy mà ghê thế, đưa file lên.
 

Miccpro

Thành viên hoạt động
Tham gia ngày
9 Tháng mười hai 2010
Bài viết
144
Được thích
7
Điểm
370
Tuổi
37
Nhờ mọi người giúp em 3 vòng for này với
Mã:
Sub Ba_vong_lap()
Dim i As Long, j As Long, n As Long
Dim Bol As Boolean
For j = 4 To 7
For n = 7 To 13
For i = 2 To 26

If Sheet1.Cells(n, j) <> "" And Sheet1.Cells(n, 3) & Sheet1.Cells(n, j) = Sheet2.Cells(i, 9) & Sheet2.Cells(i, 10).Value Then Bol = true

Next i
if Bol = False then  Sheet1.Cells(n, j) = "Sai"
Next n
Next j
end sub
Nếu em đưa
Mã:
if Bol = False then  Sheet1.Cells(n, j) = "Sai"
vào trong vòng For i thì nó thay hết các giá trị, ngược lại như trên thì nó chỉ thay được nếu giá trị đầu tiên thỏa mãn điều kiện
Em xin cảm ơn
 

befaint

|||||||||||||
Tham gia ngày
6 Tháng một 2011
Bài viết
8,719
Được thích
9,989
Điểm
560

Ba Tê

Cạo Rồi Khỏi Gội
Tham gia ngày
5 Tháng năm 2009
Bài viết
11,201
Được thích
15,921
Điểm
1,860
Tuổi
60
Nơi ở
An Giang
Cảm ơn anh, em gửi file ạ
Tìm thấy thì thoát vòng lặp, True/False phải trả lại ban đầu trước mỗi lần tìm.
PHP:
Public Sub GPE_01()
Dim Rng As Range, Arr(), I As Long, J As Long, N As Long, DK As Boolean
Arr = Sheets("Du Lieu").Range("I1", Sheets("Du Lieu").Range("J2").End(xlDown)).Value
Set Rng = Sheets("Run").Range("C7:G13")
    For J = 2 To 5
        For I = 1 To 7
            If Rng(I, J).Value <> "" Then
                DK = False
                Tem = Rng(I, 1).Value & "#" & Rng(I, J).Value
                For N = 1 To UBound(Arr)
                    If Arr(N, 1) & "#" & Arr(N, 2) = Tem Then
                        DK = True: Exit For
                    End If
                Next N
                If DK = False Then Rng(I, J).Value = "Sai"
            End If
        Next I
    Next J
Set Rng = Nothing
End Sub
Hoặc như vầy:
PHP:
Public Sub GPE_02()
Dim sArr(), I As Long, J As Long, Tem As String
With CreateObject("Scripting.Dictionary")
    sArr = Sheets("Du Lieu").Range("I1", Sheets("Du Lieu").Range("J2").End(xlDown)).Value
    For I = 1 To UBound(sArr)
        .Item(sArr(I, 1) & "#" & sArr(I, 2)) = ""
    Next I
    sArr = Sheets("Run").Range("C7:G13").Value
    For J = 2 To 5
        For I = 1 To 7
            If sArr(I, J) <> "" Then
                Tem = sArr(I, 1) & "#" & sArr(I, J)
                If Not .Exists(Tem) Then sArr(I, J) = "Sai"
            End If
        Next I
    Next J
    Sheets("Run").Range("C22:G28") = sArr
End With
End Sub
 

lequan2583

Thành viên mới
Tham gia ngày
28 Tháng chín 2011
Bài viết
15
Được thích
3
Điểm
365
Nhờ Bác Ba Tê xem sửa giúp code để tổng hợp dữ liệu với 2 điều kiện ( xin lỗi Bác vì đã chen ngang)

trong bài toán trích lọc danh sách duy nhất và tổng hợp dữ liệu với 2 điều kiện
1. trùng part code cột B sheet PO
2. trùng Delivery date cột K sheet PO
thì tổng hợp dữ liệu số lượng cột L (Qty) từ sheet Po sang sheet linkpo như file đính kèm

nhưng trong code hiện tại chưa đáp ứng được điều kiện thứ 2
vì khi xóa dữ liệu ngày ở sheet linkpo từ ô G9 trở đi thì vẫn ra kết quả bình thường

Sub linkpo()
On Error GoTo 1:
Dim Rng(), Arr(), Dic As Object, t, lCal
Dim c As Long, i As Long, K As Long, D As Long, Tem As String
Application.ScreenUpdating = False
lCal = Application.Calculation: Application.Calculation = xlCalculationManual
t = Timer
Const nCol = 1000
Set Dic = CreateObject("Scripting.Dictionary")

With Sheets("linkpo")
K = .[B15000].End(xlUp).Row:
If K > 2 Then .[A10].Resize(K - 2, nCol).ClearContents
D = .[F9].Value
End With
With Sheets("po"): Rng = .Range(.[B5], .[B15000].End(xlUp)).Resize(, 11).Value: End With
ReDim Arr(1 To UBound(Rng, 1), 1 To nCol)
K = 0
For i = 1 To UBound(Rng, 1)
If Rng(i, 10) <> "" Then
c = Rng(i, 10) - D + 6
Tem = Rng(i, 1)
If Dic.Exists(Tem) Then
Arr(Dic.Item(Rng(i, 1)), c) = Arr(Dic.Item(Rng(i, 1)), c) + Rng(i, 11)
Else
K = K + 1: Dic.Add (Tem), K
Arr(K, 1) = K: Arr(K, 3) = Tem: Arr(K, c) = Rng(i, 11)
Arr(K, 4) = Rng(i, 2)
End If
End If
Next i
Set Dic = Nothing
Sheets("linkpo").[A10].Resize(K, nCol).Value = Arr
With Sheets("linkpo")
Range("B10").Select
ActiveCell.FormulaR1C1 = "=vlookupD(RC[1],'Master list'!R2C2:R50C3,2,3,1)"
Range("B10").Select
Selection.AutoFill Destination:=Range("B10:B48")
Range("E10").Select
ActiveCell.FormulaR1C1 = "=vlookupD(RC[-2],'Master list'!R2C3:R50C5,3,2,1)"
Range("E10").Select
Selection.AutoFill Destination:=Range("E10:E48")
Range("B10").Select

End With

1: Application.ScreenUpdating = True: Application.Calculation = lCal

End Sub

Attachments
 

File đính kèm

Miccpro

Thành viên hoạt động
Tham gia ngày
9 Tháng mười hai 2010
Bài viết
144
Được thích
7
Điểm
370
Tuổi
37
Các anh chị cho em hỏi tại sao bài anh Ba Tê trả lời giúp em lại không thấy được ạ. Khi em phải đăng xuất thì lại thấy, cảm ơn anh Ba Tê (em không thấy bài anh để cảm ơn)
Tìm thấy thì thoát vòng lặp, True/False phải trả lại ban đầu trước mỗi lần tìm.


PHP:
Public Sub GPE_01()
Dim Rng As Range, Arr(), I As Long, J As Long, N As Long, DK As Boolean
Arr = Sheets("Du Lieu").Range("I1", Sheets("Du Lieu").Range("J2").End(xlDown)).Value
Set Rng = Sheets("Run").Range("C7:G13")
For J = 2 To 5
For I = 1 To 7
If Rng(I, J).Value <> "" Then
DK = False
Tem = Rng(I, 1).Value & "#" & Rng(I, J).Value
For N = 1 To UBound(Arr)
If Arr(N, 1) & "#" & Arr(N, 2) = Tem Then
DK = True: Exit For
End If
Next N
If DK = False Then Rng(I, J).Value = "Sai"
End If
Next I
Next J
Set Rng = Nothing
End Sub


Hoặc như vầy:


PHP:
Public Sub GPE_02()
Dim sArr(), I As Long, J As Long, Tem As String
With CreateObject("Scripting.Dictionary")
sArr = Sheets("Du Lieu").Range("I1", Sheets("Du Lieu").Range("J2").End(xlDown)).Value
For I = 1 To UBound(sArr)
.Item(sArr(I, 1) & "#" & sArr(I, 2)) = ""
Next I
sArr = Sheets("Run").Range("C7:G13").Value
For J = 2 To 5
For I = 1 To 7
If sArr(I, J) <> "" Then
Tem = sArr(I, 1) & "#" & sArr(I, J)
If Not .Exists(Tem) Then sArr(I, J) = "Sai"
End If
Next I
Next J
Sheets("Run").Range("C22:G28") = sArr
End With
End Sub
 

Sunbinsuzin

Thành viên mới
Tham gia ngày
8 Tháng sáu 2018
Bài viết
23
Được thích
0
Điểm
13
Tuổi
28
Kiểu này nên có file thì may ra có đáp án cho bạn.
Xin nhận khuyết điểm là em quá ngây thơ khi nhìn ảnh.



Cái hàm bạn muốn viết nó tính toán cái gì vậy mà ghê thế, đưa file lên.
Mục file của em là trích lọc DUY NHẤT theo 6 điều kiện sau đó tính tổng số lượng ạ. Em mới tập tành viết tới 6 điều kiện hàm đã chạy ì ạch rồi nên nhờ mấy bác sửa code lại dùm em với a. cám ơn các bác trước :D

Code trong file FILE TEXT DO TIM 6 DIEU KIEN + TINH SUM.xls

Function SUMTK6DK(DK1, DK2, DK3, DK4, DK5, DK6 As Variant, VUNGDK1, VUNGDK2, VUNGDK3, VUNGDK4, VUNGDK5, VUNGDK6, VUNGKQ As Range)
On Error Resume Next
Dim I As Integer, iCount As Integer, TAM As Variant
iCount = VUNGDK1.Rows.Count
For I = 1 To iCount
If UCase(VUNGDK1.Cells(I, 1)) = UCase(DK1) Then
If UCase(VUNGDK2.Cells(I, 1)) = UCase(DK2) Then
If UCase(VUNGDK3.Cells(I, 1)) = UCase(DK3) Then
If UCase(VUNGDK4.Cells(I, 1)) = UCase(DK4) Then
If UCase(VUNGDK5.Cells(I, 1)) = UCase(DK5) Then
If UCase(VUNGDK6.Cells(I, 1)) = UCase(DK6) Then
TAM = TAM + VUNGKQ.Cells(I, 1)
End If
End If
End If
End If
End If
End If
Next I
SUMTK6DK = TAM
End Function
Function TK6DK(DK1, DK2, DK3, DK4, DK5, DK6 As Variant, _
VUNGDK1, VUNGDK2, VUNGDK3, VUNGDK4, VUNGDK5, VUNGDK6, VUNGKQ As Range)
Dim I As Integer, iCount As Integer
iCount = VUNGDK1.Rows.Count
For I = 1 To iCount
If UCase(VUNGDK1.Cells(I, 1)) + UCase(VUNGDK2.Cells(I, 1)) = UCase(DK1) + UCase(DK2) Then
If UCase(VUNGDK3.Cells(I, 1)) = UCase(DK3) Then
If UCase(VUNGDK4.Cells(I, 1)) = UCase(DK4) Then
If UCase(VUNGDK5.Cells(I, 1)) = UCase(DK5) Then
If UCase(VUNGDK6.Cells(I, 1)) = UCase(DK6) Then
TK6DK = VUNGKQ.Cells(I, 1)
Exit For
End If
End If
End If
End If
End If
Next I
End Function
 

File đính kèm

ndu96081631

Huyền thoại GPE
Thành viên BQT
Super Moderator
Tham gia ngày
5 Tháng sáu 2008
Bài viết
30,166
Được thích
52,381
Điểm
11,910
Topic đã quá dài ---> Đóng topic
Anh em có nhu cầu hỏi về code (chung chung) vui lòng mở topic khác
 
Status
Không mở trả lời sau này.
Top Bottom