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

Liên hệ QC

Người dùng đang xem chủ đề này

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,954
Tiền tệ cột nào bạn và bị lỗi ra sao?
Nhờ A kiểm tra lại dùm đoạn code xem sao cột L14:L gí trị Sum() thì đúng còn giá trị tổng tiền có 1 giá.
vd: số lượng*TSC*(đơn giá+trợ giá) cho ra cùng 1 kết quả cho dù số lượng có bao nhiêu cũng vậy.
A thông cảm cho em làm phiền tí nha.
CẢm ơn A
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 = Sheet9.Range("A2:O" & Sheet9.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, 1, 11, 1, 1, 10, 12, 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) <> 1 Then dArr(k, j + 1) = Arr(i, iCol(j))
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 + 13)).Sort Key1:=.Range("M14:M" & (k + 13)), order1:=xlDescending, Header:=xlNo
.Range("L14").FormulaR1C1 = "=RC[-5]*RC[-2]*(RC[-1]+RC[1])"
.Range("L14").AutoFill Destination:=.Range("L14:L" & (k + 13)), Type:=xlFillDefault
.Range("L14:L" & (k + 13)).Value = .Range("L14:L" & (k + 13)).Value
j = .Range("A65000").End(xlUp).Row
For i = j To 13 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("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(, 13).Font.Color = -16776961
.Offset(1).Resize(, 6).HorizontalAlignment = xlCenter
.Offset(1).Resize(, 6).Merge
.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 = "=HamDocTV(" & .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
Nhờ các bác hỗ trợ,

Do mình mới đọc code nên chưa rõ lắm, nhờ được các ACE hỗ trợ đặc biệt là bác HLMT (cảm ơn bác nhiều lắm)
Nhưng có một số lỗi mình không tự dò được:
- Phần định dạng cột dữ liệu trong đoạn [DOANH SO T4] mình cần định dạng số liệu dạng #,###
- Khi bảng dữ liệu ra dư 1 dòng cuối cùng.
đoạn code như sau:
và file đính kèm.

Sub GuiMail_11062018()

Dim objOutlook, objOutlookMsg, cn, rst As Object

Dim arr As Variant

Dim str1, str2, str3 As String

Dim i As Integer

Set objOutlook = CreateObject("Outlook.Application")

Set objOutlookMsg = objOutlook.CreateItem(0)

Set cn = CreateObject("ADODB.Connection")

Set rst = CreateObject("ADODB.Recordset")

cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0"

rst.Open ("select * from [DS_MAIL$]"), cn

arr = rst.GetRows()

rst.Close

For i = 3 To UBound(arr)

rst.Open ("select [SL POS T4],[DOANH SO T4],[PHI THU T4],[SL POS T5],[DOANH SO T5],[PHI THU T5],[+/- SL T5 VA T4],[% KH SL],[+/- DS T5 VA T4],[% KH DS],[+/- PT T5 VA T4],[% KH Phí] from [Data 1$] where MADV='" & arr(1, i) & "'"), cn, 3

If rst.RecordCount > 0 Then

str1 = rst.GetString(, , "</td><td>", "</tr><tr>")

Else

str1 = ""

End If

rst.Close

rst.Open ("select [Ghi Chú] from [Data 1$] where MaDv='" & arr(1, i) & "'"), cn

If rst.RecordCount > 0 Then

str3 = rst.GetString(, , "</td><td>", "</tr><tr>")

Else

str3 = ""

End If

rst.Close

rst.Open ("select [STT],[Tid Local-Visa],[Tid Master],[Tên DVCNT],[Adress],[Phone],[Active date],[POS Type],[Status],[Serial POS],[Code NV],[Ghi chú] from [Data 2$] where MaDv='" & arr(1, i) & "'"), cn

If rst.RecordCount > 0 Then

str2 = rst.GetString(, , "</td><td>", "</tr><tr>")

Else

str2 = ""

End If

If Len(str1) > 0 And Len(str2) > 0 Then



Set objOutlookMsg = objOutlook.CreateItem(0)

With objOutlookMsg

.To = arr(2, i)

.CC = arr(3, i)

.Subject = Sheet4.[A1] & arr(1, i)

.HTMLBody = "<strong>" & Sheet4.[A3] & "</strong><br><br>" & Sheet4.[A5] & _

" <br><table border='1'><th>SL POS T4</th><th>DOANH SO T4</th><th>PHI THU T4</th><th>SL POS T5</th><th>DOANH SO T5</th><th>PHI THU T5</th><th>+/- SL T5 VA T4</th><th>% KH SL</th><th>+/- DS T5 VA T4</th><th>% KH DS</th><th>+/- PT T5 VA T4</th><th>% KH Phí</th> <tr>" & _

str1 & "</table><br>" & Sheet4.[A7] & _

"</strong><br>&nbsp&nbsp&nbsp&nbsp<font face='Wingdings'>Ø</font> " & str3 & _

"<br>&nbsp&nbsp&nbsp&nbsp<font face='Wingdings'>Ø</font> " & _

Sheet4.[A9] & " </strong><br>" & _

Sheet4.[A10] & _

"</strong><table border='1'><th>STT</th><th>Tid Local-Visa</th><th>Tid Master</th><th>Tên DVCNT</th><th>Adress</th><th>Phone</th><th>Active date</th><th>POS Type</th><th>Status</th><th>Serial POS</th><th>Code NV</th><th>Ghi chú</th> <tr>" & str2 & "</table><br>" & _

Sheet4.[A12] & "</strong><br><br>" & _

Sheet4.[A14] & "</strong>"

.Display

End With

End If

rst.Close

Next



End Sub
 

File đính kèm

Upvote 0
Nhờ A kiểm tra lại dùm đoạn code xem sao cột L14:L gí trị Sum() thì đúng còn giá trị tổng tiền có 1 giá.
vd: số lượng*TSC*(đơn giá+trợ giá) cho ra cùng 1 kết quả cho dù số lượng có bao nhiêu cũng vậy.
A thông cảm cho em làm phiền tí nha.
CẢm ơn A
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 = Sheet9.Range("A2:O" & Sheet9.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, 1, 11, 1, 1, 10, 12, 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) <> 1 Then dArr(k, j + 1) = Arr(i, iCol(j))
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 + 13)).Sort Key1:=.Range("M14:M" & (k + 13)), order1:=xlDescending, Header:=xlNo
.Range("L14").FormulaR1C1 = "=RC[-5]*RC[-2]*(RC[-1]+RC[1])"
.Range("L14").AutoFill Destination:=.Range("L14:L" & (k + 13)), Type:=xlFillDefault
.Range("L14:L" & (k + 13)).Value = .Range("L14:L" & (k + 13)).Value
j = .Range("A65000").End(xlUp).Row
For i = j To 13 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("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(, 13).Font.Color = -16776961
.Offset(1).Resize(, 6).HorizontalAlignment = xlCenter
.Offset(1).Resize(, 6).Merge
.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 = "=HamDocTV(" & .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
Bạn nêu vd mẫu cụ thể đi, cột nào bằng bao nhiêu, do đâu, sai chổ nào, như thế nào mới đúng, nhưng nhớ phải là con số cụ thể.
 
Upvote 0
Bạn nêu vd mẫu cụ thể đi, cột nào bằng bao nhiêu, do đâu, sai chổ nào, như thế nào mới đúng, nhưng nhớ phải là con số cụ thể.
Bạn nêu vd mẫu cụ thể đi, cột nào bằng bao nhiêu, do đâu, sai chổ nào, như thế nào mới đúng, nhưng nhớ phải là con số cụ thể.
Nhờ A xem cột tô đỏ. Cảm ơn nhiều
 

File đính kèm

Upvote 0
Đưa file, kèm theo mô tả mục đích, mọi người viết lại cho nhanh, chứ chỉnh mấy cái macro mất nhiều thời gian mà vẫn dễ có lỗi.
Nếu chỉ dùng code để copy dữ liệu không thì dùng code này.
Mã:
Private Sub Workbook_Open()
Dim Wb As Workbook, tWb As Workbook
Set tWb = ThisWorkbook
    tWb.Sheets("PO").Cells.ClearContents
    tWb.Sheets("GIA").Cells.ClearContents
    Set Wb = Workbooks.Open(tWb.Path & "\PO.xlsx")
    Wb.Sheets(1).Cells.Copy tWb.Sheets("PO").Range("A1")
    Wb.Close False
    Set Wb = Workbooks.Open(tWb.Path & "\Gia.xlsx")
    Wb.Sheets(1).Cells.Copy tWb.Sheets("Gia").Range("A1")
    Wb.Close False
End Sub

Mục đích của em là lấy Giá ở trong file PO history dựa và TÊN VẬT TƯ và PO.
Dữ liệu đầu vào của em chỉ có TÊN VẬT TƯ còn PO thì tìm trong FilelayPO dựa và TÊN VẬT TƯ và MAX số lượng của loại TÊN VẬT TƯ đó.
Bác giaiphap đã giúp em code copy dữ liệu và 1 file để tiện sử lý dữ liệu nhưng mà file PO history ở Cty em có password mở file, password chỉ đọc và 1 cái thông báo link ko tìm thấy file khi mở trên máy của em.
Bác có thể viết thêm dùm em đoạn:
Code kiểm tra file đó có tồn tại không trước khi mở file copy dữ liệu dùm em vợi ạ " vì sever Cty em hay rớt mạng"
Code tự động nhập password vào file PO history "VD Password: 123456", bỏ qua cái bảng thông báo nhập pass chỉ đọc và 1 cái bảng thông báo link hỏng được không ạ. Nếu sai password thì thông báo sai password.
Code tự động lấy các thông tim khi nhập thêm dữ liệu vào cột TÊN VẬT TƯ.
Code chuyển đổi 2 cái hàm tìm PO và Số lượng sang code
Và cuối cùng đoạn code ở dưới em tham khảo bài #1784 nhưng không hiểu sao code chỉ hiện được có 6 kết quả trong khi chạy bằng hàm thì ra rất nhiều kết quả. Và không hiểu sao lúc em đang text code hiện ra hết quả mà giờ lại hết hiện kết quả luôn.

Sub test()
Dim I, lr As Integer
lr = Sheets("THONGTIN").Range("A" & Rows.Count).End(xlUp).Row
For I = 2 To lr
If Sheets("GIA").Range("A" & I) = Sheets("THONGTIN").Range("O" & I) And _
Sheets("GIA").Range("B" & I) = Sheets("THONGTIN").Range("M" & I) Then
Sheets("GIA").Range("D" & I).Value = Sheets("Thongtin").Range("V" & I).Value
End If
Next
End Sub

Thank Bác
LOI.jpg
 

File đính kèm

Upvote 0
Nhờ A xem cột tô đỏ. Cảm ơn nhiều
Sửa lại code thế này xem sao?
Mã:
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 = Sheet9.Range("A2:O" & Sheet9.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, 1, 11, 1, 1, 10, 12, 25, 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) <> 1 Then
                    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 + 13)).Sort Key1:=.Range("M14:M" & (k + 13)), order1:=xlDescending, Header:=xlNo
            j = .Range("A65000").End(xlUp).Row
            For i = j To 13 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("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, 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 = "=HamDocTV(" & .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
Mục đích của em là lấy Giá ở trong file PO history dựa và TÊN VẬT TƯ và PO.
Dữ liệu đầu vào của em chỉ có TÊN VẬT TƯ còn PO thì tìm trong FilelayPO dựa và TÊN VẬT TƯ và MAX số lượng của loại TÊN VẬT TƯ đó.
Bác giaiphap đã giúp em code copy dữ liệu và 1 file để tiện sử lý dữ liệu nhưng mà file PO history ở Cty em có password mở file, password chỉ đọc và 1 cái thông báo link ko tìm thấy file khi mở trên máy của em.
Bác có thể viết thêm dùm em đoạn:
Code kiểm tra file đó có tồn tại không trước khi mở file copy dữ liệu dùm em vợi ạ " vì sever Cty em hay rớt mạng"
Code tự động nhập password vào file PO history "VD Password: 123456", bỏ qua cái bảng thông báo nhập pass chỉ đọc và 1 cái bảng thông báo link hỏng được không ạ. Nếu sai password thì thông báo sai password.
Code tự động lấy các thông tim khi nhập thêm dữ liệu vào cột TÊN VẬT TƯ.
Code chuyển đổi 2 cái hàm tìm PO và Số lượng sang code
Và cuối cùng đoạn code ở dưới em tham khảo bài #1784 nhưng không hiểu sao code chỉ hiện được có 6 kết quả trong khi chạy bằng hàm thì ra rất nhiều kết quả. Và không hiểu sao lúc em đang text code hiện ra hết quả mà giờ lại hết hiện kết quả luôn.

Sub test()
Dim I, lr As Integer
lr = Sheets("THONGTIN").Range("A" & Rows.Count).End(xlUp).Row
For I = 2 To lr
If Sheets("GIA").Range("A" & I) = Sheets("THONGTIN").Range("O" & I) And _
Sheets("GIA").Range("B" & I) = Sheets("THONGTIN").Range("M" & I) Then
Sheets("GIA").Range("D" & I).Value = Sheets("Thongtin").Range("V" & I).Value
End If
Next
End Sub

Thank Bác
View attachment 197276
Tôi thì mù tịch về công thức mảng, chính vì vậy nhìn công thức mảng của bạn thì chịu. Bạn giải thích rõ từng cột lấy ra sao, dựa vào tiêu chí nào, tại sao lại không lấy giá trị này mà phải lấy giá trị khác...
 
Lần chỉnh sửa cuối:
Upvote 0
Sửa lại code thế này xem sao?
Mã:
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 = Sheet9.Range("A2:O" & Sheet9.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, 1, 11, 1, 1, 10, 12, 25, 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) <> 1 Then
                    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 + 13)).Sort Key1:=.Range("M14:M" & (k + 13)), order1:=xlDescending, Header:=xlNo
            j = .Range("A65000").End(xlUp).Row
            For i = j To 13 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("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, 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 = "=HamDocTV(" & .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
OK rồi Anh. Quá tuyệt
Chân thành cảm ơn A đã giúp đỡ
Bài đã được tự động gộp:

Code ok rồi Anh quá tuyệt
Chân thành cảm ơn Anh
 
Upvote 0
Sửa lại code thế này xem sao?
Mã:
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 = Sheet9.Range("A2:O" & Sheet9.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, 1, 11, 1, 1, 10, 12, 25, 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) <> 1 Then
                    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 + 13)).Sort Key1:=.Range("M14:M" & (k + 13)), order1:=xlDescending, Header:=xlNo
            j = .Range("A65000").End(xlUp).Row
            For i = j To 13 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("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, 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 = "=HamDocTV(" & .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

Tôi thì mù tịch về công thức mảng, chính vì vậy nhìn công thức mảng của bạn thì chịu. Bạn giải thích rõ từng cột lấy ra sao, dựa vào tiêu chí nào, tại sao lại không lấy giá trị này mà phải lấy giá trị khác...

Dạ để em giải thích:
Khi nhận được đơn hàng sẽ kiểm tra tồn kho còn bao nhiêu, nếu thiếu thì mua thêm
khi tính giá thì tính theo số lượng vật tư nào sử dụng nhiều hơn (nếu vật tư cũ sử dụng nhiều hơn thì lấy giá cũ, nếu vật tư mới mua về sử dụng nhiều hơn thì sẽ lấy giá mới mua)
Ví dụ khi nắp ráp 1000 linh kiện vào ngày 12/06/2018 mình cần 3000 vật tư A, 4000 vật tư B thì Cty em tính như vầy:
sẽ lấy toàn bộ 1000 vật tư A của PO 18051033 số còn thiếu là 2000 vật tư A sẽ lấy của PO 18051034 nên sẽ lấy Giá mua/0.55 đô
lấy toàn bộ 3000 vật tư B của PO 18051040 số còn thiếu là 1000 vật tư A sẽ lấy của PO 18051034 nênsẽ lấy Giá mua/0.40 đô
Linh liện/ A Số hóa đơn(PO)/ 18051033 Số Lượng/1000 Ngày Mua/12/01/2017 Giá mua/0.50 đô
Linh liện/ A Số hóa đơn(PO)/ 18051034 Số Lượng/7000 Ngày Mua/12/05/2018 Giá mua/0.55 đô
Linh liện/ B Số hóa đơn(PO)/ 18051040 Số Lượng/3000 Ngày Mua/12/01/2017 Giá mua/0.40 đô
Linh liện/ B Số hóa đơn(PO)/ 18051034 Số Lượng/4000 Ngày Mua/12/05/2018 Giá mua/0.49 đô
Những thông tin trong 3 file trên là người ta sẽ giử cho mình còn mình chỉ việc ráp giá vào là xong ạ.
cám ơn bác đã qua tâm giúp đỡ :D
 
Upvote 0
Dạ để em giải thích:
Khi nhận được đơn hàng sẽ kiểm tra tồn kho còn bao nhiêu, nếu thiếu thì mua thêm
khi tính giá thì tính theo số lượng vật tư nào sử dụng nhiều hơn (nếu vật tư cũ sử dụng nhiều hơn thì lấy giá cũ, nếu vật tư mới mua về sử dụng nhiều hơn thì sẽ lấy giá mới mua)
Ví dụ khi nắp ráp 1000 linh kiện vào ngày 12/06/2018 mình cần 3000 vật tư A, 4000 vật tư B thì Cty em tính như vầy:
sẽ lấy toàn bộ 1000 vật tư A của PO 18051033 số còn thiếu là 2000 vật tư A sẽ lấy của PO 18051034 nên sẽ lấy Giá mua/0.55 đô
lấy toàn bộ 3000 vật tư B của PO 18051040 số còn thiếu là 1000 vật tư A sẽ lấy của PO 18051034 nênsẽ lấy Giá mua/0.40 đô
Linh liện/ A Số hóa đơn(PO)/ 18051033 Số Lượng/1000 Ngày Mua/12/01/2017 Giá mua/0.50 đô
Linh liện/ A Số hóa đơn(PO)/ 18051034 Số Lượng/7000 Ngày Mua/12/05/2018 Giá mua/0.55 đô
Linh liện/ B Số hóa đơn(PO)/ 18051040 Số Lượng/3000 Ngày Mua/12/01/2017 Giá mua/0.40 đô
Linh liện/ B Số hóa đơn(PO)/ 18051034 Số Lượng/4000 Ngày Mua/12/05/2018 Giá mua/0.49 đô
Những thông tin trong 3 file trên là người ta sẽ giử cho mình còn mình chỉ việc ráp giá vào là xong ạ.
cám ơn bác đã qua tâm giúp đỡ :D
Tôi thuộc dạng luôn luôn lắng nghe, nhưng lâu lâu mới hiểu. Chính vì vậy bạn giải thích thật sự tôi chẳng hiểu luôn, thôi thì giúp được cho bạn cái này nhé, còn cái còn lại nếu hiểu thì làm còn hiện giờ chưa hiểu gì cả. Bạn thêm code này cho Module.
Mã:
Function File_Check(s As String) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
File_Check = fso.FileExists(s)
End Function
Bạn sửa code trong ThisWorkbook như sau:
Mã:
Private Sub Workbook_Open()
Dim wb As Workbook, tWb As Workbook
Set tWb = ThisWorkbook
    tWb.Sheets("PO").Cells.Clear
    tWb.Sheets("THONGTIN").Cells.Clear
    On Error GoTo Loi
    If Not File_Check(ThisWorkbook.Path & "\FilelayPO.xlsx") Then
        MsgBox "Ten tin FilelayPO.xlsx khong ton tai"
        Exit Sub
    End If
    If Not File_Check(ThisWorkbook.Path & "\PO history.xlsx") Then
        MsgBox "Ten tin PO history.xlsx khong ton tai"
        Exit Sub
    End If
    Set wb = Workbooks.Open(tWb.Path & "\FilelayPO.xlsx")
    wb.Sheets(1).Cells.Copy tWb.Sheets("PO").Range("A1")
    wb.Close False
    Set wb = Workbooks.Open(tWb.Path & "\PO history.xlsx", Password:="11", writeResPassword:="1", UpdateLinks:=0)
    wb.Sheets(1).Cells.Copy tWb.Sheets("THONGTIN").Range("A1")
    wb.Close False
Loi:
    If Err.Number = 1004 Then MsgBox "Passwork mo file chua chinh xac"
End Sub
 
Upvote 0
Tôi thuộc dạng luôn luôn lắng nghe, nhưng lâu lâu mới hiểu. Chính vì vậy bạn giải thích thật sự tôi chẳng hiểu luôn, thôi thì giúp được cho bạn cái này nhé, còn cái còn lại nếu hiểu thì làm còn hiện giờ chưa hiểu gì cả. Bạn thêm code này cho Module.
Mã:
Function File_Check(s As String) As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
File_Check = fso.FileExists(s)
End Function
Bạn sửa code trong ThisWorkbook như sau:
Mã:
Private Sub Workbook_Open()
Dim wb As Workbook, tWb As Workbook
Set tWb = ThisWorkbook
    tWb.Sheets("PO").Cells.Clear
    tWb.Sheets("THONGTIN").Cells.Clear
    On Error GoTo Loi
    If Not File_Check(ThisWorkbook.Path & "\FilelayPO.xlsx") Then
        MsgBox "Ten tin FilelayPO.xlsx khong ton tai"
        Exit Sub
    End If
    If Not File_Check(ThisWorkbook.Path & "\PO history.xlsx") Then
        MsgBox "Ten tin PO history.xlsx khong ton tai"
        Exit Sub
    End If
    Set wb = Workbooks.Open(tWb.Path & "\FilelayPO.xlsx")
    wb.Sheets(1).Cells.Copy tWb.Sheets("PO").Range("A1")
    wb.Close False
    Set wb = Workbooks.Open(tWb.Path & "\PO history.xlsx", Password:="11", writeResPassword:="1", UpdateLinks:=0)
    wb.Sheets(1).Cells.Copy tWb.Sheets("THONGTIN").Range("A1")
    wb.Close False
Loi:
    If Err.Number = 1004 Then MsgBox "Passwork mo file chua chinh xac"
End Sub
Em nghĩ tại Bác có ác cảm gì đó với hàm mảng thông chứ Bác lập trình hay vậy thì làm gì có chuyện ko ..... thực ra em nghĩ khi mình sử dụng hàm mảng trong exccel thì excel sẽ dùng vòng nặp để tìm giá trị cho cell.
Em làm lại 1 cái file nhưng em tách hàm ra và dữ liệu thì dễ nhìn hơn. Bác rảnh thì vào xem dùm em với ạ.
thank bác
New Bitmap Image.jpg
 

File đính kèm

Upvote 0
Chào cả nhà ạ.

Cả nhà cho em hỏi. Em muốn chuyển biểu thức ở dạng chuỗi( vd "800>=500" ; "1000<300") về kiểu logic bằng cách nào ạ.

Em cám ơn.
 
Upvote 0
Upvote 0
mình gõ y nguyên vào rồi mà đâu có được đâu :
Gái xinh có khác, suy nghĩ cũng hại nào phết nhỉ, người ta hỏi tách bạch là ("800>=500" ; "1000<300" ), hai biểu thức riêng biệt, chứ có phải là m ột đâu mà nhét chúng vào một mớ chứ.
Bài đã được tự động gộp:

2, 3 chuỗi như vậy sao anh Bill hiểu kết quả là gì.
Viết thế là sai cú pháp luôn, chứ 2 3 biểu thức gì trời.
 
Upvote 0
Gái xinh có khác, suy nghĩ cũng hại nào phết nhỉ, người ta hỏi tách bạch là ("800>=500" ; "1000<300" ), hai biểu thức riêng biệt, chứ có phải là m ột đâu mà nhét chúng vào một mớ chứ.
Bài đã được tự động gộp:


Viết thế là sai cú pháp luôn, chứ 2 3 biểu thức gì trời.

Ồ thế ra là do mình không biết chưa biết cú pháp VBA, lại làm phiền các anh chị, thật ngại quá. hic.
 
Upvote 0
mình gõ y nguyên vào rồi mà đâu có được đâu :

Mã:
MsgBox Application.Evaluate("800>=500" ; "1000<300")

Nếu được thì kết quả là cái gì?
Cái biểu thức "800>=500" ; "1000<300" ông cố Pi ta go, Ơ cơ lit, Dề cát còn chưa hiểu nữa chứ đừng nói cái thằng đần VBA.
 
Upvote 0
Status
Không mở trả lời sau này.
Web KT

Bài viết mới nhất

Back
Top Bottom