Chuyên mục xử lý, gỡ rối code VBA (1 người xem)

[ndu96081631]

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

 

[batman1]

Bạn gái xinh đẹp cho hỏi còn cách khác nào nữa không?

Ai lại đi nhìn ảnh? Ảnh thế nhưng lúc quên vẫn khà khà khà như thường.

 

[AutoReply]

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]

Ấ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]

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É!!!!!!!!!!!

 

[SA_DQ]

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á ạ
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.

 

[Sunbinsuzin]

Kiểu này nên có file thì may ra có đáp án cho bạn.

Dạ để mai em UP file a.
Thank bác

 

[giaiphap]

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]

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.

TK6DK = VUNGKQ.Cells(I, 1)

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]

Nhờ mọi người giúp em 3 vòng for này với

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

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]

Nhờ

Gửi file lên xem nào: Cho gì, cần gì và kết quả minh họa. Có hơn 100 bài viết rồi mà...

Sheet1.Cells(n, 3) & Sheet1.Cells(n, j) = Sheet2.Cells(i, 9) & Sheet2.Cells(i, 10).Value

1&39 == 13&9 thì làm sao?

Chỗ thì không có, chỗ thì có màu đỏ.

 

[Miccpro]

Gửi file lên xem nào: Cho gì, cần gì và kết quả minh họa. Có hơn 100 bài viết rồi mà...

Cảm ơn anh, em gửi file ạ

 

[Ba Tê]

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.

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:

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]

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

 

[Miccpro]

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]

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

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

 

[ndu96081631]

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