Hỗ trợ làm phiếu xuất theo mã phiếu

Liên hệ QC
vanlinhmt

vanlinhmt

Thành viên mới
Tham gia
5/8/07
Bài viết
29
Được thích
41
Gửi anh em
Hiện em có tham khảo 1 phiếu xuất trên GPE.
Phiếu có Kết quả như tại sheet"hientai". Giờ mong muốn có Kết quả như Sheet"mongmuon" (__File đính kèm)
Rất mong anh em hỗ trợ
Cảm ơn anh em rất nhiều

Vanlinhmt
 

File đính kèm

  • phieuXuat.xlsm
    24.9 KB · Đọc: 16
Sắp xếp theo thời gian sắp xếp theo bầu chọn
vanlinhmt đã viết:
Gửi anh em
Hiện em có tham khảo 1 phiếu xuất trên GPE.
Phiếu có Kết quả như tại sheet"hientai". Giờ mong muốn có Kết quả như Sheet"mongmuon" (__File đính kèm)
Rất mong anh em hỗ trợ
Cảm ơn anh em rất nhiều

Vanlinhmt
Nhấp chuột vào đây để mở rộng...
Phiếu trình bày như vậy có ổn không?
Khách hàng là ngày? Số xe là kho? KTP01 là số xe? Ghi chus 1 là gì? STT đánh 1 - 4 hay 1 -2? Sau cột số lượng là cột gì?
217908
 
Upvote 0
vanlinhmt đã viết:
Gửi anh em
Hiện em có tham khảo 1 phiếu xuất trên GPE.
Phiếu có Kết quả như tại sheet"hientai". Giờ mong muốn có Kết quả như Sheet"mongmuon" (__File đính kèm)
Rất mong anh em hỗ trợ
Cảm ơn anh em rất nhiều

Vanlinhmt
Nhấp chuột vào đây để mở rộng...
Thử cái này.
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim arr(), KQ(), dArr():
 Dim DaNap As Boolean
 Dim tong As Double, W As Long, J As Long, i As Long, Rws As Long, dic As Object
 Set dic = CreateObject("scripting.dictionary")
 
 If Target.Address = "$H$2" Then
    Rws = Sheet1.Range("C4").CurrentRegion.Rows.Count
    arr = Sheet1.Range("C4").Resize(Rws, 10).Value
    ReDim KQ(1 To UBound(arr), 1 To 8):
    Rows("11:23").Hidden = False
    
    For i = 1 To UBound(arr)
        If arr(i, 1) = Target.Value Then
            If Not DaNap Then
                dArr() = Array(arr(i, 7), arr(i, 8), arr(i, 9), arr(i, 10))
                DaNap = True
            End If

        If Not dic.exists(arr(i, 3)) Then
            W = W + 1
            KQ(W, 1) = W
                dic.Add arr(i, 3), W
            For J = 2 To 4
                KQ(W, J) = arr(i, J)
            Next J
            KQ(W, 6) = arr(i, 6)
            KQ(W, 8) = arr(i, 10)
        Else
           a = dic.Item(arr(i, 3))
           KQ(a, 6) = KQ(a, 6) + arr(i, 6)
           KQ(a, 8) = KQ(a, 8) & ChrW(10) & arr(i, 10)
        End If
        tong = tong + arr(i, 6)
      End If
    Next i
    Range("B10:I23").ClearContents
    
    If W = 0 Then
        MsgBox "Không Có Du Liêu!":
        Exit Sub
    Else
        [D5].Resize(4).Value = Application.WorksheetFunction.Transpose(dArr())
        Range("b10").Resize(W, 8) = KQ:
        [G24].Value = tong
        
        Rows(11 + W & ":23").Hidden = True
    End If
 End If
End Sub
 
Upvote 0
Upvote 0
be09 đã viết:
Làm ăn kiểu như vậy là không ổn, sau cột số lượng là cột thâm hụt ngân sách (ghi nợ nhiều quá nên không dám đưa lên).
Nhấp chuột vào đây để mở rộng...
Dạ không phải như vậy đâu anh. Oan quá ạ.
Em cảm ơn anh em đã hỗ trợ nhiều.
Bài đã được tự động gộp:

snow25 đã viết:
Thử cái này.
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim arr(), KQ(), dArr():
Dim DaNap As Boolean
Dim tong As Double, W As Long, J As Long, i As Long, Rws As Long, dic As Object
Set dic = CreateObject("scripting.dictionary")

If Target.Address = "$H$2" Then
    Rws = Sheet1.Range("C4").CurrentRegion.Rows.Count
    arr = Sheet1.Range("C4").Resize(Rws, 10).Value
    ReDim KQ(1 To UBound(arr), 1 To 8):
    Rows("11:23").Hidden = False
   
    For i = 1 To UBound(arr)
        If arr(i, 1) = Target.Value Then
            If Not DaNap Then
                dArr() = Array(arr(i, 7), arr(i, 8), arr(i, 9), arr(i, 10))
                DaNap = True
            End If

        If Not dic.exists(arr(i, 3)) Then
            W = W + 1
            KQ(W, 1) = W
                dic.Add arr(i, 3), W
            For J = 2 To 4
                KQ(W, J) = arr(i, J)
            Next J
            KQ(W, 6) = arr(i, 6)
            KQ(W, 8) = arr(i, 10)
        Else
           a = dic.Item(arr(i, 3))
           KQ(a, 6) = KQ(a, 6) + arr(i, 6)
           KQ(a, 8) = KQ(a, 8) & ChrW(10) & arr(i, 10)
        End If
        tong = tong + arr(i, 6)
      End If
    Next i
    Range("B10:I23").ClearContents
   
    If W = 0 Then
        MsgBox "Không Có Du Liêu!":
        Exit Sub
    Else
        [D5].Resize(4).Value = Application.WorksheetFunction.Transpose(dArr())
        Range("b10").Resize(W, 8) = KQ:
        [G24].Value = tong
       
        Rows(11 + W & ":23").Hidden = True
    End If
End If
End Sub
Nhấp chuột vào đây để mở rộng...

Chính xác rồi.
Cảm ơn bạn rất nhiều.
Bài đã được tự động gộp:

leonguyenz đã viết:
Phiếu trình bày như vậy có ổn không?
Khách hàng là ngày? Số xe là kho? KTP01 là số xe? Ghi chus 1 là gì? STT đánh 1 - 4 hay 1 -2? Sau cột số lượng là cột gì?
View attachment 217908
Nhấp chuột vào đây để mở rộng...

File dữ liệu giả định lấy trên GPE thôi các phần không quan trọng mình tinh chỉnh sau.
Mục đích mình vừa tham khảo vừa học hỏi đồng thời áp dụng làm với file của mình.
Cảm ơn leonguyenz đã xem và tư vấn
 
Lần chỉnh sửa cuối:
Upvote 0
vanlinhmt đã viết:
Dạ không phải như vậy đâu anh. Oan quá ạ.
Em cảm ơn anh em đã hỗ trợ nhiều.
Bài đã được tự động gộp:



Chính xác rồi.
Cảm ơn bạn rất nhiều.
Bài đã được tự động gộp:



File dữ liệu giả định lấy trên GPE thôi các phần không quan trọng mình tinh chỉnh sau.
Mục đích mình vừa tham khảo vừa học hỏi đồng thời áp dụng làm với file của mình.
Cảm ơn leonguyenz đã xem và tư vấn
Nhấp chuột vào đây để mở rộng...
Tham khảo thêm code sau, chèn vào sheet Mong_muon
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sArr(), i As Long, k As Long, dic As Object, reArr()
Dim Tmp As String, sumQ As Double
sArr = Sheet1.Range("C4:O" & Sheet1.Range("C65535").End(xlUp).Row).Value
ReDim reArr(1 To UBound(sArr, 1), 1 To 8)
Set dic = CreateObject("Scripting.Dictionary")
If Not Intersect(Target, Range("H2")) Is Nothing Then
    If Target.Count = 1 Then
        Range("B10:I100").Clear
        For i = 1 To UBound(sArr, 1)
            If Val(sArr(i, 1)) = Target.Value And sArr(i, 8) = Range("D5").Value _
                And sArr(i, 9) = Range("D6").Value Then
                Tmp = sArr(i, 2) & " | " & sArr(i, 3)
                If Not dic.Exists(Tmp) Then
                    k = k + 1: dic.Add Tmp, k
                    reArr(k, 1) = k
                    reArr(k, 2) = sArr(i, 2)
                    reArr(k, 3) = sArr(i, 3)
                    reArr(k, 4) = sArr(i, 4)
                    reArr(k, 6) = sArr(i, 6)
                    reArr(k, 8) = sArr(i, 10)
                    sumQ = sumQ + sArr(i, 6)
                Else
                    reArr(dic.Item(Tmp), 6) = reArr(dic.Item(Tmp), 6) + sArr(i, 6)
                    reArr(dic.Item(Tmp), 8) = reArr(dic.Item(Tmp), 8) _
                        & IIf(sArr(i, 10) = "", "", Chr(10) & sArr(i, 10))
                    sumQ = sumQ + sArr(i, 6)
                End If
            End If
        Next i
        If k Then
            Sheet5.Range("B10").Resize(k, 8) = reArr
            Range("B10").Resize(k + 1, 8).Borders.LineStyle = 1
            Range("B10").Resize(k + 1, 8).VerticalAlignment = xlCenter
            Range("B10").Resize(k, 2).HorizontalAlignment = xlCenter
            Range("C10").Offset(k) = "Total:"
            Range("G10").Offset(k) = sumQ
            Range("G10").Resize(k + 1).NumberFormat = "#,##0"
        End If
    End If
End If
End Sub
 

File đính kèm

  • phieuXuat.xlsm
    25.9 KB · Đọc: 13
Upvote 0
leonguyenz đã viết:
Tham khảo thêm code sau, chèn vào sheet Mong_muon
Mã: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sArr(), i As Long, k As Long, dic As Object, reArr()
Dim Tmp As String, sumQ As Double
sArr = Sheet1.Range("C4:O" & Sheet1.Range("C65535").End(xlUp).Row).Value
ReDim reArr(1 To UBound(sArr, 1), 1 To 8)
Set dic = CreateObject("Scripting.Dictionary")
If Not Intersect(Target, Range("H2")) Is Nothing Then
    If Target.Count = 1 Then
        Range("B10:I100").Clear
        For i = 1 To UBound(sArr, 1)
            If Val(sArr(i, 1)) = Target.Value And sArr(i, 8) = Range("D5").Value _
                And sArr(i, 9) = Range("D6").Value Then
                Tmp = sArr(i, 2) & " | " & sArr(i, 3)
                If Not dic.Exists(Tmp) Then
                    k = k + 1: dic.Add Tmp, k
                    reArr(k, 1) = k
                    reArr(k, 2) = sArr(i, 2)
                    reArr(k, 3) = sArr(i, 3)
                    reArr(k, 4) = sArr(i, 4)
                    reArr(k, 6) = sArr(i, 6)
                    reArr(k, 8) = sArr(i, 10)
                    sumQ = sumQ + sArr(i, 6)
                Else
                    reArr(dic.Item(Tmp), 6) = reArr(dic.Item(Tmp), 6) + sArr(i, 6)
                    reArr(dic.Item(Tmp), 8) = reArr(dic.Item(Tmp), 8) _
                        & IIf(sArr(i, 10) = "", "", Chr(10) & sArr(i, 10))
                    sumQ = sumQ + sArr(i, 6)
                End If
            End If
        Next i
        If k Then
            Sheet5.Range("B10").Resize(k, 8) = reArr
            Range("B10").Resize(k + 1, 8).Borders.LineStyle = 1
            Range("B10").Resize(k + 1, 8).VerticalAlignment = xlCenter
            Range("B10").Resize(k, 2).HorizontalAlignment = xlCenter
            Range("C10").Offset(k) = "Total:"
            Range("G10").Offset(k) = sumQ
            Range("G10").Resize(k + 1).NumberFormat = "#,##0"
        End If
    End If
End If
End Sub
Nhấp chuột vào đây để mở rộng...

Cảm ơn leonguyenz nhiều nhé.
Đưa mong muốn học hỏi là được hỗ trợ thêm chi tiết ngay.
Trước giờ chỉ duyệt trên Range giờ mới tìm hiểu về mảng lại thấy cần phải đọc về Dictionary nữa.
Muốn nạp kiến thức 1 lần vào đầu như nạp range vào mảng thì tốt quá :)
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

A
Tìm số nhỏ nhất, số lớn nhất theo ngày
Trả lời
6
Đọc
45
hoangtuaotrang_hp_vn
H
H
  • Question
Code VBA cho kết quả dòng, cột theo điều kiện từ 2 Sheets
Trả lời
1
Đọc
28
VetMini
V
test1986
  • Question
HELP! Sử dụng combobox để cập nhật dữ liệu trong file Excel
Trả lời
16
Đọc
475
BuiQuangThuan
B
NguyenthiH
  • Question
Code lấy dữ liệu cho sheet!TonDau.
Trả lời
1
Đọc
27
BuiQuangThuan
B
youneededme
Hộ em hàm cthuc mảng dùng index với ạ sao giải hoài nó cứ lổ ref huhu cảm ơn nhiều ạ
Trả lời
2
Đọc
63
VetMini
V
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom