cách lọc bảng dữ liệu từ sổ dữ liệu sang phiếu xuất kho

Liên hệ QC

cuongpc96

Thành viên mới
Tham gia
1/12/18
Bài viết
2
Được thích
0
Các a/c cho e hỏi giờ e có bảng dữ liệu như vậy. Làm sao để sang sheet phiếu xuất chỉ cần bấm số phiếu nó hiện lên trên cột tên hàng những nhiên liệu đã sử dụng ạ. Em xin cám ơn ạ
 

File đính kèm

  • Book1 - Copy.xlsm
    36.8 KB · Đọc: 12
Bạn chủ bài đăng: Bạn đẩy dòng chứa từ 'Cộng' xuống dòng 26 & xài macro sự kiện này:
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [I1]) Is Nothing Then
    Dim Rws As Long, J As Long, Col As Integer, W As Integer
    Dim Rng As Range, sRng As Range
    
    Rows("10:25").Hidden = False
    With Sheet1
        Rws = .[B2].CurrentRegion.Rows.Count
        Col = .[B2].CurrentRegion.Columns.Count
        ReDim Arr(1 To Col, 1 To 9)
        [A10].Resize(Col, 9).Value = Arr()
        Set Rng = .[A1].Resize(Rws)
        Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
        If sRng Is Nothing Then
            MsgBox "Nothing!", , "GPE.COM Xin Luu Ý!"
        Else
            Rws = sRng.Row
            For J = 1 To Col
                If sRng.Offset(, J).Value <> "" Then
                    W = W + 1:                                      Arr(W, 1) = W
                    Arr(W, 3) = .Cells(1, J + 1).Value
                    Arr(W, 9) = sRng.Offset(, J).Value
                End If
            Next J
        End If
    End With
    If W Then
        [A10].Resize(W, 9).Value = Arr()
        Rows(11 + W & ":25").Hidden = True
    End If
 End If
End Sub

Thiết nghĩ, chủ bài đăng cần thêm vài từ vô tiêu đề cho rõ nghĩa là được;
Ví dụ cụm từ: "từ sổ ghi chép (NKC) sang phiếu xuất kho"
 
Các a/c cho e hỏi giờ e có bảng dữ liệu như vậy. Làm sao để sang sheet phiếu xuất chỉ cần bấm số phiếu nó hiện lên trên cột tên hàng những nhiên liệu đã sử dụng ạ. Em xin cám ơn ạ
Góp ý cho bạn:
1/ Tiêu đề bài viết nên sửa là "Cách Truy vấn phiếu xuất kho từ sheet DỮ LIỆU".
2/ Phiếu xuất kho và sheet DỮ LIỆU nên có nội dung thống nhất với nhau.
3/ Theo tôi thì nên dùng Phiếu xuất kho nhập liệu vào sheet DỮ LIỆU rồi mới nghĩ đến Truy vấn phiếu xuất kho (dùng để in lại phiếu khi cần).
 
anh thế giờ cột dữ liệu của e bắt đầu từ G-L và số phiếu vẫn ở A thì thay đổi chỗ nào ạ ??? [/QUOTE]
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [I1]) Is Nothing Then
Dim Rws As Long, J As Long, Col As Integer, W As Integer
Dim Rng As Range, sRng As Range

Rows("10:25").Hidden = False
With Sheet1
Rws = .[B2].CurrentRegion.Rows.Count
Col = .[B2].CurrentRegion.Columns.Count
ReDim Arr(1 To Col, 1 To 9)
[A10].Resize(Col, 9).Value = Arr()
Set Rng = .[A1].Resize(Rws)
Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
If sRng Is Nothing Then
MsgBox "Nothing!", , "GPE.COM Xin Luu Ý!"
Else
Rws = sRng.Row
For J = 1 To Col
If sRng.Offset(, J).Value <> "" Then
W = W + 1: Arr(W, 1) = W
Arr(W, 3) = .Cells(1, J + 1).Value
Arr(W, 9) = sRng.Offset(, J).Value
End If
Next J
End If
End With
If W Then
[A10].Resize(W, 9).Value = Arr()
Rows(11 + W & ":25").Hidden = True
End If
End If
End Sub[/php]

anh thế giờ cột dữ liệu của e bắt đầu từ G-L và số phiếu vẫn ở A thì thay đổi chỗ nào ạ ??? [/QUOTE]
 

File đính kèm

  • Book1 - Copy.xlsm
    40.3 KB · Đọc: 10
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [I1]) Is Nothing Then
    Dim Rws As Long, J As Long, Col As Integer, W As Integer
    Dim Rng As Range, sRng As Range
    
    Rows("10:16").Hidden = False
    With Sheet1
        Rws = .[A2].CurrentRegion.Rows.Count        '       B   '
        Col = .[BBB1].End(xlToLeft).Column - 2         '   **      '
'        MsgBox Col          '
        ReDim Arr(1 To Col, 1 To 9)
        [A10].Resize(Col, 9).Value = Arr()
        Set Rng = .[A1].Resize(Rws)
        Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
        If sRng Is Nothing Then
            MsgBox "Nothing!", , "GPE.COM Xin Luu Ý!"
        Else
            Rws = sRng.Row
            For J = 1 To Col
                If sRng.Offset(, J).Value <> "" Then
                    W = W + 1:                                      Arr(W, 1) = W
                    Arr(W, 3) = .Cells(1, J + 1).Value
                    Arr(W, 9) = sRng.Offset(, J).Value
                End If
            Next J
        End If
    End With
    If W Then
        [A10].Resize(W, 9).Value = Arr()
        Rows(11 + W & ":16").Hidden = False
    End If
 End If
End Sub
 
. . Cho hỏi , có cách nào mà khi mình lọc không làm mất công thức ở các ô như ĐVT, Nhiệt độ, Thực xuất với VCF ko ạ
Mà có thể nào chỉ cần khai báo từ dòng 10 - 16 thôi ko a. Tại vì một phiếu của e chỉ tầm 4 loại hàng là nhiều rồi ạ
PHP:
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [I1]) Is Nothing Then
    Dim Rws As Long, J As Long, Col As Integer, W As Integer
    Dim Rng As Range, sRng As Range
    
    Rows("10:16").Hidden = False
    With Sheet1
        Rws = .[A2].CurrentRegion.Rows.Count        '       B   '
        Col = .[BBB1].End(xlToLeft).Column - 2         '   **      '
        ReDim Arr(1 To Col, 1 To 3) As String:        ReDim dArr(1 To Col, 1 To 1) As Double
        [A10].Resize(6, 3).Value = Arr():                   [e10].Resize(6).Value = ""
        Set Rng = .[A1].Resize(Rws)
        Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
        If sRng Is Nothing Then
            MsgBox "Nothing!", , "GPE.COM Xin Luu Ý!"
        Else
            Rws = sRng.Row
            For J = 1 To Col
                If sRng.Offset(, J).Value <> "" Then
                    W = W + 1:                                      Arr(W, 1) = W
                    Arr(W, 2) = "GPE" & Right("0" & CStr(J), 2)
                    Arr(W, 3) = .Cells(1, J + 1).Value
                    dArr(W, 1) = sRng.Offset(, J).Value
                End If
            Next J
        End If
    End With
    If W Then
        [A10].Resize(W, 3).Value = Arr()
        [e10].Resize(W).Value = dArr()
        Rows(11 + W & ":16").Hidden = False
    End If
 End If
End Sub
VN= Pil +1
 
Web KT
Back
Top Bottom