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

Liên hệ QC
Status
Không mở trả lời sau này.

ndu96081631

Huyền thoại GPE
Thành viên BQT
Super Moderator
Tham gia
5/6/08
Bài viết
30,703
Được thích
53,918
Sao cái Form này quen quá nhỉ. Cái này bạn phải đính kèm file nên rồi

Thì đúng rồi. Tôi có nói ở trên là tôi học và làm được tất cả là từ GPE mà.
còn cái form thì tôi sử dụng nguồn bài viết tạo phiếu bán hàng của anh Hòang Trọng Nghĩa. Xin cám ơn anh.

Hiện tại tôi đang ra ngoài nên không gởi file lên được, lát tôi về cty tôi gởi lên.

Chân thành cám ơn sự quan tâm và giúp đỡ.
 
Upvote 0

File đính kèm

  • PCT.xlsm
    198.7 KB · Đọc: 10
Upvote 0
Nhờ mấy bác trên diễn đàn giải thích dùm em code này với! Em ko hiểu tác giả kêu chuyền biến vào hàm như thế nào và thứ tự ra sao.
Nếu được thì cho em xin cái FILE ví dụ với ạ.
Code1

Option Explicit
Function FindTwoCondition(Table As Range, Val1 As Variant, _
Val2 As Variant, Val2Col As Integer, ResultCol As Integer, Optional Val1Occrnce As Integer = 1)
'Tabel Là Bang Du Lieu '
'Val1 Dièu Kien Tìm Thú Nhát '
'Val2 Dièu Kien Thú Hai '
'Val2Col Chi Só Cot Cua Dièu Kien Thú 2 '
'ResultCol Chi Só Cua Cot Càn Dò Tìm '
'Val1Occrnce Giá Tri Thú N Cua Dièu Kien Trong Cot '

Dim i As Integer, iCount As Integer
Dim rCol As Range

For i = 1 To Table.Rows.Count
If Table.Cells(i, 1) = Val1 And Table.Cells(i, Val2Col) = Val2 Then
iCount = iCount + 1
End If
If iCount = Val1Occrnce Then
FindTwoCondition = Table.Cells(i, ResultCol)
Exit For
End If
Next i
End Function
 
Lần chỉnh sửa cuối:
Upvote 0
Bài đã được tự động gộp:


Code ok rồi Anh quá tuyệt
Chân thành cảm ơn Anh
Bài đã được tự động gộp:

Tiền tệ cột nào bạn và bị lỗi ra sao?
Chào Giaiphap
Làm phiền A tí được không ạ.
E có đổi chút dữ liệu các cột nhưng trình độ chưa dịch hết code của A nên rối quá.
nhờ A sửa lại code tí sao cho e lọc được các dữ liệu theo tieu đề cột trong sheet DATA NHAP sang sheet BANGKETIEN TT THEO NGAY.
Trong sheet bangke có các cột Quy khô theo TSC và quy khô theo DRC có công thức, và đơn giá có trợ giá va cộ tổng thành tiền.
Phần tô màu đỏ, sao e đổi icol(....) thì treo code không làm việc luôn A. khi đó các flie khác có ct thì copy ko được luôn.
A giúp e lần nữa nha. Cảm ơn A
 

File đính kèm

  • PHIEU MUA nho sua code.xls
    2.6 MB · Đọc: 4
Lần chỉnh sửa cuối:
Upvote 0
Chào MTuan, post: 862947, member: 107717

Sao tên trang tính fải lê thê làm vậy; Không xài tiếng Việt có dấu trong nớ có được chăng?

Mà trong file mở ra có thấy 'miếng' Code nào đâu mà dò ra chổ đúng sai!
 
Upvote 0
Bài đã được tự động gộp:


Chào Giaiphap
Làm phiền A tí được không ạ.
E có đổi chút dữ liệu các cột nhưng trình độ chưa dịch hết code của A nên rối quá.
nhờ A sửa lại code tí sao cho e lọc được các dữ liệu theo tieu đề cột trong sheet DATA NHAP sang sheet BANGKETIEN TT THEO NGAY.
Trong sheet bangke có các cột Quy khô theo TSC và quy khô theo DRC có công thức, và đơn giá có trợ giá va cộ tổng thành tiền.
Phần tô màu đỏ, sao e đổi icol(....) thì treo code không làm việc luôn A. khi đó các flie khác có ct thì copy ko được luôn.
A giúp e lần nữa nha. Cảm ơn A
Tôi thật sự không còn kiên nhẫn để giúp bạn nửa, đã hỏi kỷ bạn ở bài trên rồi, xem lại còn chổ nào chưa ổn nửa không để giúp lần một, giúp xong lại phát sinh, bạn còn bảo tự phát triển code được. Thôi thì lần cuối nhé, xem lại và khẳng định còn sửa gì nửa không? :D:D:D
 
Upvote 0
Tôi thật sự không còn kiên nhẫn để giúp bạn nửa, đã hỏi kỷ bạn ở bài trên rồi, xem lại còn chổ nào chưa ổn nửa không để giúp lần một, giúp xong lại phát sinh, bạn còn bảo tự phát triển code được. Thôi thì lần cuối nhé, xem lại và khẳng định còn sửa gì nửa không? :D:D:D
Dạ chào giaiphap
Mong A thông cảm. trước giờ e làm tay và dò bằng vlookup ra dc bảng kê nhưng quá chậm. Nay có A giúp nên muốn tahy đổi mẫu luôn vì trước đây cũng muố thay đổi mẫu rồi nhưng sợ sửa công thức có dc ko nữa nên vẫn áp dụng vậy mà xài.
Nay nhờ có A giúp đỡ code nên em tiến hành đổi mẫu. ban đầu như thế nhưng khi trao đổi cùng ace làm chung thì mẫu có chút thay đổi.
E cũng ngại quá mấy ngày nay ko dám gửi file nhờ A do code sau cùng của A thì quá tuyệt ko cần điều chỉnh theo mẫu trước. Nhưng thôi phiền A giúp trót em lần cuối cho xong. tại em đang học VB mà chưa đến đâu nên chưa phát triển dc A à.
em gửi file lên rồi nhờ A xem có sheet tonghop nếu dc A giúp em luôn nha.
Mong là phiền lần nữa A đừng giận. CẢm ơn rất nhiều
Bài đã được tự động gộp:

Sao tên trang tính fải lê thê làm vậy; Không xài tiếng Việt có dấu trong nớ có được chăng?

Mà trong file mở ra có thấy 'miếng' Code nào đâu mà dò ra chổ đúng sai!
Dạ code viết trong VB của Sheet nha A. vào VB bDclick vào sheet A sẽ thấy
Cảm ơn Anh
 

File đính kèm

  • PHIEU MUA nho sua code.xls
    2.6 MB · Đọc: 8
Upvote 0
Thử chạy code này:
PHP:
Public Sub Update_CSDL()
Dim sArr(), tArr(), I As Long, J As Long, Rws As Long, R As Long, Txt As String
tArr = Sheets("Thongtin").Range("A2", Sheets("Thongtin").Range("A2").End(xlDown)).Resize(, 45).Value
With CreateObject("Scripting.Dictionary")
    For I = 1 To UBound(tArr)
        .Item(tArr(I, 1) & "#" & tArr(I, 2)) = I
    Next I
    sArr = Sheets("CSDL").Range("A2", Sheets("CSDL").Range("A2").End(xlDown)).Resize(, 45).Value
    R = UBound(sArr)
    For I = 1 To R
        Txt = sArr(I, 1) & "#" & sArr(I, 2)
        If .Exists(Txt) Then
            Rws = .Item(Txt)
            For J = 13 To 32
                sArr(I, J) = tArr(Rws, J)
            Next J
        End If
    Next I
End With
Sheets("CSDL").Range("A2").Resize(R, 45) = sArr
End Sub
Em mới tập tành viết code vba bác có thể chú thích cho em ý nghĩa của đoạn code mà bác viết ở trên được ko ạ.
Cám ơn bác
 
Upvote 0
Mọi người giúp đỡ làm thế nào để k hiện dòng rỗng trên ListBox, tes.JPG
list box trên có thanh trượt và dòng rỗng, mình đã add thêm điều kiện loại dòng rỗng mà không được
tham khao đính kèm
thanks
 

File đính kèm

  • Array2DToListBox.xlsb
    22.9 KB · Đọc: 8
Upvote 0

File đính kèm

  • Array2DToListBox (1).xlsb
    27.8 KB · Đọc: 9
Lần chỉnh sửa cuối:
Upvote 0
Mọi người giúp đỡ làm thế nào để k hiện dòng rỗng trên ListBox, list box trên có thanh trượt và dòng rỗng, mình đã add thêm điều kiện loại dòng rỗng mà không được
Cảm ơn
Trong khai báo mảng aDes vì bạn chưa biết kích thước của nó nên bạn khai báo thành 60000 dòng, tuy nhiên VBA chỉ cho phép định lại kích cỡ chiều cuối cùng của mảng nhiều chiều nên bạn không thể xóa dòng trống bằng Redim Preserve được. Để khắc phục điều này thì dễ nhất là dùng Dictionary, load các key và số lượng vào dic, công việc này chỉ làm lần đầu tiên khi bắt đầu chương trình, các key tìm được cũng dùng để đưa vào combobox luôn, sau này có thêm bớt các key NOS G, NOS K... không cần sửa lại code nữa.
 
Upvote 0
Dạ chào giaiphap
Mong A thông cảm. trước giờ e làm tay và dò bằng vlookup ra dc bảng kê nhưng quá chậm. Nay có A giúp nên muốn tahy đổi mẫu luôn vì trước đây cũng muố thay đổi mẫu rồi nhưng sợ sửa công thức có dc ko nữa nên vẫn áp dụng vậy mà xài.
Nay nhờ có A giúp đỡ code nên em tiến hành đổi mẫu. ban đầu như thế nhưng khi trao đổi cùng ace làm chung thì mẫu có chút thay đổi.
E cũng ngại quá mấy ngày nay ko dám gửi file nhờ A do code sau cùng của A thì quá tuyệt ko cần điều chỉnh theo mẫu trước. Nhưng thôi phiền A giúp trót em lần cuối cho xong. tại em đang học VB mà chưa đến đâu nên chưa phát triển dc A à.
em gửi file lên rồi nhờ A xem có sheet tonghop nếu dc A giúp em luôn nha.
Mong là phiền lần nữa A đừng giận. CẢm ơn rất nhiều
Bài đã được tự động gộp:


Dạ code viết trong VB của Sheet nha A. vào VB bDclick vào sheet A sẽ thấy
Cảm ơn Anh
Sửa code như sau:
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Arr(), dArr(), iCol1(), i As Integer, k As Integer, Ngay, j As Integer, Rng As Range, KHO As String
If Target.Address = "$A$3" Then
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Arr = Sheet10.Range("A2:P" & Sheet10.Range("A65000").End(xlUp).Row).Value
    ReDim dArr(1 To UBound(Arr, 1), 1 To 13)
    Ngay = Target.Value: KHO = Sheet25.[$C$7]
    iCol = Array(9, 4, 5, 6, 7, 10, 11, 14, 3, 8, 25, 1, 13)
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        If (Ngay = Arr(i, 2)) And (KHO = Arr(i, 8)) Then
            k = k + 1
            For j = 0 To 12
                If iCol(j) = 25 Then
                    dArr(k, j + 1) = Arr(i, 10) * Arr(i, 11) * (Arr(i, 12) + Arr(i, 13))
                ElseIf iCol(j) = 3 Then
                    dArr(k, j + 1) = (dArr(k, j) * dArr(k, j - 2)) / 100
                ElseIf iCol(j) = 8 Then
                    dArr(k, j + 1) = (dArr(k, j - 3) * dArr(k, j - 2)) / 100
                ElseIf iCol(j) = 1 Then
                     dArr(k, j + 1) = dArr(k, j - 5) * dArr(k, j - 1) * dArr(k, j)
                Else
                    dArr(k, j + 1) = Arr(i, iCol(j))
                End If
            Next j
        End If
    Next i
    Sheet25.Range("A14:M" & (Sheet25.Range("A65000").End(xlUp).Row) + 5).Clear
    If k <> 0 Then
        With Sheet25
            .Range("A14").Resize(k, 13).Value = dArr
            .Sort.SortFields.Clear
            .Range("A14:M" & (k + 14)).Sort Key1:=.Range("M14:M" & (k + 14)), order1:=xlDescending, Header:=xlNo
            j = .Range("A65000").End(xlUp).Row
            For i = j To 14 Step -1
                If .Range("M" & i) <> .Range("M" & (i - 1)) Then
                    .Rows(i & ":" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
                    .Range("B" & i).Value = "Toång hoä baùn thöôøng xuyeân ñöôïc trôï giaù +" & .Range("M" & (i + 1)).Value & " ñoàng/TSC"
                    .Range("B" & i).Font.Name = "VNI-Times"
                    .Range("B" & i & ":L" & i).Font.Bold = True
                End If
            Next i
            For Each Rng In .Range("L14:L" & .Range("L65000").End(xlUp).Row).SpecialCells(2).Areas
                .Range("I" & (Rng.Row - 1)).Formula = "=sum(" & Replace(Rng.Offset(, -3).Address, "$", "") & ")"
                .Range("J" & (Rng.Row - 1)).Formula = "=sum(" & Replace(Rng.Offset(, -2).Address, "$", "") & ")"
                .Range("L" & (Rng.Row - 1)).Formula = "=sum(" & Replace(Rng.Address, "$", "") & ")"
            Next
            .Range("M14:M" & .Range("A65000").End(xlUp).Row).ClearContents
            With .Range("A65000").End(xlUp)
                .Offset(1).Value = "Toång giaù trò haøng hoùa ñöôïc mua vaøo "
                .Offset(1).Resize(, 13).Font.Name = "VNI-Times"
                .Offset(1).Resize(, 13).Font.Bold = True
                .Offset(1).Resize(, 6).HorizontalAlignment = xlCenter
                .Offset(1).Resize(, 6).Merge
                .Offset(1, 8).Formula = "=SUMIF(R14C3:R[-1]C3,"""",R14C9:R[-1]C9)"
                .Offset(1, 9).Formula = "=SUMIF(R14C3:R[-1]C3,"""",R14C10:R[-1]C10)"
                .Offset(1, 11).Formula = "=SUMIF(R14C3:R[-1]C3,"""",R14C12:R[-1]C12)"
            End With
            .Range("A14:M" & .Range("A65000").End(xlUp).Row).Borders.LineStyle = 1
            With .Range("A65000").End(xlUp).Offset(1)
                .Value = "Baèng chöõ:"
                .Offset(, 1).Formula = "=DocSoAbc(" & .Offset(-1, 11).Address & ")" 'Sua ham doc tieng viet cho nay
                .Offset(2, 1).Value = "Ngöôøi laäp baûng keâ"
                .Offset(2, 1).Font.Bold = True
                .Offset(1, 11).Value = "Ngaøy ... thaùng .... naêm ......"
                .Offset(2, 11).Value = "Giaùm ñoác danh nghieäp"
                .Offset(2, 11).Font.Bold = True
                .Offset(3, 1).Value = "(Kyù vaø ghi roõ hoï teân)"
                .Offset(3, 11).Value = "(Kyù teân, ñoùng daáu)"
                .Offset(2, 1).Resize(2).HorizontalAlignment = xlCenter
                .Offset(1, 11).Resize(3).HorizontalAlignment = xlCenter
                .Resize(5, 13).Font.Name = "VNI-Times"
            End With
        End With
   End If
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End If
End Sub
 
Upvote 0
Upvote 0
Sửa code như sau:
Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Arr(), dArr(), iCol1(), i As Integer, k As Integer, Ngay, j As Integer, Rng As Range, KHO As String
If Target.Address = "$A$3" Then
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Arr = Sheet10.Range("A2:P" & Sheet10.Range("A65000").End(xlUp).Row).Value
    ReDim dArr(1 To UBound(Arr, 1), 1 To 13)
    Ngay = Target.Value: KHO = Sheet25.[$C$7]
    iCol = Array(9, 4, 5, 6, 7, 10, 11, 14, 3, 8, 25, 1, 13)
    For i = LBound(Arr, 1) To UBound(Arr, 1)
        If (Ngay = Arr(i, 2)) And (KHO = Arr(i, 8)) Then
            k = k + 1
            For j = 0 To 12
                If iCol(j) = 25 Then
                    dArr(k, j + 1) = Arr(i, 10) * Arr(i, 11) * (Arr(i, 12) + Arr(i, 13))
                ElseIf iCol(j) = 3 Then
                    dArr(k, j + 1) = (dArr(k, j) * dArr(k, j - 2)) / 100
                ElseIf iCol(j) = 8 Then
                    dArr(k, j + 1) = (dArr(k, j - 3) * dArr(k, j - 2)) / 100
                ElseIf iCol(j) = 1 Then
                     dArr(k, j + 1) = dArr(k, j - 5) * dArr(k, j - 1) * dArr(k, j)
                Else
                    dArr(k, j + 1) = Arr(i, iCol(j))
                End If
            Next j
        End If
    Next i
    Sheet25.Range("A14:M" & (Sheet25.Range("A65000").End(xlUp).Row) + 5).Clear
    If k <> 0 Then
        With Sheet25
            .Range("A14").Resize(k, 13).Value = dArr
            .Sort.SortFields.Clear
            .Range("A14:M" & (k + 14)).Sort Key1:=.Range("M14:M" & (k + 14)), order1:=xlDescending, Header:=xlNo
            j = .Range("A65000").End(xlUp).Row
            For i = j To 14 Step -1
                If .Range("M" & i) <> .Range("M" & (i - 1)) Then
                    .Rows(i & ":" & i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
                    .Range("B" & i).Value = "Toång hoä baùn thöôøng xuyeân ñöôïc trôï giaù +" & .Range("M" & (i + 1)).Value & " ñoàng/TSC"
                    .Range("B" & i).Font.Name = "VNI-Times"
                    .Range("B" & i & ":L" & i).Font.Bold = True
                End If
            Next i
            For Each Rng In .Range("L14:L" & .Range("L65000").End(xlUp).Row).SpecialCells(2).Areas
                .Range("I" & (Rng.Row - 1)).Formula = "=sum(" & Replace(Rng.Offset(, -3).Address, "$", "") & ")"
                .Range("J" & (Rng.Row - 1)).Formula = "=sum(" & Replace(Rng.Offset(, -2).Address, "$", "") & ")"
                .Range("L" & (Rng.Row - 1)).Formula = "=sum(" & Replace(Rng.Address, "$", "") & ")"
            Next
            .Range("M14:M" & .Range("A65000").End(xlUp).Row).ClearContents
            With .Range("A65000").End(xlUp)
                .Offset(1).Value = "Toång giaù trò haøng hoùa ñöôïc mua vaøo "
                .Offset(1).Resize(, 13).Font.Name = "VNI-Times"
                .Offset(1).Resize(, 13).Font.Bold = True
                .Offset(1).Resize(, 6).HorizontalAlignment = xlCenter
                .Offset(1).Resize(, 6).Merge
                .Offset(1, 8).Formula = "=SUMIF(R14C3:R[-1]C3,"""",R14C9:R[-1]C9)"
                .Offset(1, 9).Formula = "=SUMIF(R14C3:R[-1]C3,"""",R14C10:R[-1]C10)"
                .Offset(1, 11).Formula = "=SUMIF(R14C3:R[-1]C3,"""",R14C12:R[-1]C12)"
            End With
            .Range("A14:M" & .Range("A65000").End(xlUp).Row).Borders.LineStyle = 1
            With .Range("A65000").End(xlUp).Offset(1)
                .Value = "Baèng chöõ:"
                .Offset(, 1).Formula = "=DocSoAbc(" & .Offset(-1, 11).Address & ")" 'Sua ham doc tieng viet cho nay
                .Offset(2, 1).Value = "Ngöôøi laäp baûng keâ"
                .Offset(2, 1).Font.Bold = True
                .Offset(1, 11).Value = "Ngaøy ... thaùng .... naêm ......"
                .Offset(2, 11).Value = "Giaùm ñoác danh nghieäp"
                .Offset(2, 11).Font.Bold = True
                .Offset(3, 1).Value = "(Kyù vaø ghi roõ hoï teân)"
                .Offset(3, 11).Value = "(Kyù teân, ñoùng daáu)"
                .Offset(2, 1).Resize(2).HorizontalAlignment = xlCenter
                .Offset(1, 11).Resize(3).HorizontalAlignment = xlCenter
                .Resize(5, 13).Font.Name = "VNI-Times"
            End With
        End With
   End If
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End If
End Sub
Không biết phải nói thế nào để cảm ơn A. Quá tuyệt
Xin đa tạ.
 
Upvote 0
Nghe nói em có bệnh hả em ? Nhớ uống thuốc kẻo bệnh nặng thêm nha em. Và điều đầu tiên cần làm là đổi hình đại diện lại nha em :{{
Làm gì có chuyện bạn xinh gái ý có bệnh, bạn lại đoán mò rùi, có cao kiến về code thì phát biểu đi, đừng có nghẹn ngào cả ngày thế.
 
Upvote 0
Làm gì có chuyện bạn xinh gái ý có bệnh, bạn lại đoán mò rùi, có cao kiến về code thì phát biểu đi, đừng có nghẹn ngào cả ngày thế.

Mình nghe người ta nói bạn ấy có bệnh nên mình quan tâm hỏi thăm người ta, đâu có nói gì đến bạn nhỉ ?
Mình chưa có rành cú pháp VBA nữa thì lấy đâu ra cao kiến để phát biểu hả bạn ? Bạn làm khó mình rồi.
 
Upvote 0
Status
Không mở trả lời sau này.
Web KT
Back
Top Bottom