Lấy thông tin từ phiếu xuất kho - Phân tách sang 2 biên bản theo Nơi bàn giao (2 người xem)

[quyenpv]

Trước tiên em rất cám ơn các anh trên 4rum đã giúp đỡ rất nhiều trong quá trình mày mò học hỏi. Em có sưu tầm được đoạn code lấy thông tin từ file đang đóng nhưng không biết sửa thế nào để phù hợp với mình cả, nên mạo muội nhờ các anh chỉ tiếp
1. Em muốn lấy thông tin từ phiếu xuất kho đưa vào bảng Input
2. Từ đó em xác định được vật tư được bàn giao về kho nào (Làm bằng tay ạ)
3. Nhờ các anh viết code có thể từ nơi bàn giao đẩy sang 2 biên bản giúp em

Mong các anh giúp đỡ và chỉ bảo. Cám ơn các anh rất nhiều

 

[quyenpv]

Em đã tìm ra nhưng cách làm không hay đó là em lấy tất cả thông tin sau đó dùng Autofilter để lọc giữa 2 biên bản bàn giao.
Hu hu các anh có cao kiến giúp em với ạ

 

[Let'GâuGâu]

Em đã tìm ra nhưng cách làm không hay đó là em lấy tất cả thông tin sau đó dùng Autofilter để lọc giữa 2 biên bản bàn giao.
Hu hu các anh có cao kiến giúp em với ạ

không hiểu được ý bạn.......bạn viết rất khó hiểu, nhất là cái câu thứ 3 bài#1
thấy code xài ADO.....chắc ai cũng ngại làm.....heheheheeh
======
tôi hiểu yêu cầu của bài bạn là
ở sheet "input" căn cứ vào cột F "nơi bàn giao"
khoKV3 chép qua sheet BVKhoKV
khoCN chép qua sheet BVKhoCN
có đúng là vậy ko?

 

[quyenpv]

Dạ đúng anh ạ. Từ Sheet Input có nơi bàn giao em xác định bằng tay. Nhờ các anh viết Code để đẩy sang 2 Sheet dự vào cột nơi bàn giao ạ

 

[Let'GâuGâu]

Dạ đúng anh ạ. Từ Sheet Input có nơi bàn giao em xác định bằng tay. Nhờ các anh viết Code để đẩy sang 2 Sheet dự vào cột nơi bàn giao ạ

tôi có sửa lại một chút
cái "kho KV3" thành "kho KV" cho giống tên sheet
vùng dữ liệu chép đến các sheet bắt đầu từ dòng 28

 

[quyenpv]

Sub tachkho()
Dim SheetName, data, item As Variant, i, j, k As Long, kq(), shname As String, SH As Worksheet
On Error Resume Next
SheetName = Array("Kho KV", "Kho CN")
With Sheet3
    data = .[b9].Resize(.[b6000].End(3).Row, 5).Value
End With


For Each item In SheetName


shname = "BG " & Replace(item, " ", "")
Set SH = Worksheets(shname)


ReDim kq(1 To UBound(data), 1 To 8)
    For i = 1 To UBound(data)
        If data(i, 5) = item Then   'Phan ktra Kho=Sheet
            k = k + 1
            kq(k, 1) = k            'STT
            kq(k, 2) = data(i, 1)   'Ten Vat Tu
            kq(k, 5) = data(i, 2)   'Serial     kq(k,5)     chi cot hien thi Serial
                                    '           data(i,2)   chi noi lay du lieu tu Sheet Input
            kq(k, 6) = data(i, 3)   'DVT
            kq(k, 7) = data(i, 6)   'So luong
            kq(k, 8) = data(i, 4)   'Tinh trang
        End If
    Next
With Sheets(shname)
.[a28:i1000].ClearContents
.[a28].Resize(k, 8).Value = kq
End With
k = 0
Erase kq
Next


On Error GoTo 0
End Sub

Anh Let's Gâu Gâu ơi chỉ giúp em với nó không hiển thị số lượng sang 2 biên bản mặc dù em đã thêm vào vòng lặp rồi.
Mong anh phản hồi sớm vợi ạ

 

[quyenpv]

Em đã tìm ra nguyên nhân rồi. Ở đoạn code này

With Sheet3
   [COLOR=#0000ff] data = .[b9].Resize(.[b6000].End(3).Row, 5).Value[/COLOR]
End With

Thay bằng

With Sheet3
   [COLOR=#0000FF] data = .[b9].Resize(.[b6000].End(3).Row, 6).Value[/COLOR]
End With

Học hỏi các sư phụ bằng cách dịch từng dòng code xem nó chạy thế nào chứ chưa có khả năng viết được. Mong được sự giúp đỡ của các anh chị

 

[Let'GâuGâu]

Học hỏi các sư phụ bằng cách dịch từng dòng code xem nó chạy thế nào chứ chưa có khả năng viết được. Mong được sự giúp đỡ của các anh chị

thực tế thì bạn có bao nhiêu kho, nếu chỉ có 2 kho thì bỏ bớt một vòng lặp đi

 

[quyenpv]

Của em chỉ có 2 kho thôi anh ạ. Bỏ vòng lặp Fỏ bên trên hả anh

 

[Quang_Hải]

Dạ đúng anh ạ. Từ Sheet Input có nơi bàn giao em xác định bằng tay. Nhờ các anh viết Code để đẩy sang 2 Sheet dự vào cột nơi bàn giao ạ

Thử code này xem sao

Sub TachKho()
Dim Kq1(), Kq2(), Data(), i, x, y
Data = Sheet3.Range("B9", Sheet3.[G65536].End(3)).Value
ReDim Kq1(1 To UBound(Data), 1 To 8)
ReDim Kq2(1 To UBound(Data), 1 To 8)
For i = 1 To UBound(Data)
   If Data(i, 5) = "Kho CN" Then
      x = x + 1
      Kq1(x, 1) = x
      Kq1(x, 2) = Data(i, 1)
      Kq1(x, 5) = Data(i, 2)
      Kq1(x, 6) = Data(i, 3)
      Kq1(x, 7) = Data(i, 6)
      Kq1(x, 8) = Data(i, 4)
   ElseIf Data(i, 5) = "Kho KV" Then
      y = y + 1
      Kq2(y, 1) = y
      Kq2(y, 2) = Data(i, 1)
      Kq2(y, 5) = Data(i, 2)
      Kq2(y, 6) = Data(i, 3)
      Kq2(y, 7) = Data(i, 6)
      Kq2(y, 8) = Data(i, 4)
   End If
Next
Sheets("BG KhoCN").[A28].Resize(x, 8) = Kq1
Sheets("BG KhoKV").[A28].Resize(y, 8) = Kq2
End Sub

 

[VetMini]

Làm việc trên nhiều nơi (sheets) có câu trúc in hệt nhau như trường hợp này thì dùng mảng chứa mảng.

Dim Kq(1 To 2), KqA(), Data(), i, x(1 To 2), sNum
Data = Sheet3.Range("B9", Sheet3.[G65536].End(3)).Value
ReDim KqA(1 To UBound(Data), 1 To 8)
Kq(1) = KqA
Kq(2) = KqA
For i = 1 To UBound(Data)
   sNum = IIf(Data(i, 5) = "Kho CN", 1, IIf(Data(i, 5) = "Kho KV", 2, 0))
   If sNum Then
      x(sNum) = x(sNum) + 1
      Kq(sNum)(x(sNum), 1) = x(sNum)
      Kq(sNum)(x(sNum), 2) = Data(i, 1)
      Kq(sNum)(x(sNum), 5) = Data(i, 2)
      Kq(sNum)(x(sNum), 6) = Data(i, 3)
      Kq(sNum)(x(sNum), 7) = Data(i, 6)
      Kq(sNum)(x(sNum), 8) = Data(i, 4)
   End If
Sheets("BG KhoCN").[A28].Resize(x(1), 8) = Kq(1)
Sheets("BG KhoCN").[A28].Resize(x(2), 8) = Kq(2)

Hoặc là:

Type MULARR
  ar() As Variant
  ln As Integer
End Type

sub xyz()
Dim Kq(1 To 2) As MULARR
Dim Data(), i, sNum
Data = Sheet3.Range("B9", Sheet3.[G65536].End(3)).Value
ReDim Kq(1).ar(1 To UBound(Data), 1 To 8)
ReDim Kq(2).ar(1 To UBound(Data), 1 To 8)
For i = 1 To UBound(Data)
   sNum = IIf(Data(i, 5) = "Kho CN", 1, IIf(Data(i, 5) = "Kho KV", 2, 0))
   If sNum Then
      Kq(sNum).ln = Kq(sNum).ln + 1
      Kq(sNum).ar(Kq(sNum).ln, 1) =  Kq(sNum).ln
      Kq(sNum).ar(Kq(sNum).ln, 2) = Data(i, 1)
      Kq(sNum).ar(Kq(sNum).ln, 5) = Data(i, 2)
      Kq(sNum).ar(Kq(sNum).ln, 6) = Data(i, 3)
      Kq(sNum).ar(Kq(sNum).ln, 7) = Data(i, 6)
      Kq(sNum).ar(Kq(sNum).ln, 8) = Data(i, 4)
   End If
Sheets("BG KhoCN").[A28].Resize(Kq(1).ln, 8) = Kq(1).ar
Sheets("BG KhoCN").[A28].Resize(Kq(2).ln, 8) = Kq(2).ar
end sub

 

[Kiều Mạnh]

Làm việc trên nhiều nơi (sheets) có câu trúc in hệt nhau như trường hợp này thì dùng mảng chứa mảng.

Dim Kq(1 To 2), KqA(), Data(), i, x(1 To 2), sNum
Data = Sheet3.Range("B9", Sheet3.[G65536].End(3)).Value
ReDim KqA(1 To UBound(Data), 1 To 8)
Kq(1) = KqA
Kq(2) = KqA
For i = 1 To UBound(Data)
   sNum = IIf(Data(i, 5) = "Kho CN", 1, IIf(Data(i, 5) = "Kho KV", 2, 0))
   If sNum Then
      x(sNum) = x(sNum) + 1
      Kq(sNum)(x(sNum), 1) = x(sNum)
      Kq(sNum)(x(sNum), 2) = Data(i, 1)
      Kq(sNum)(x(sNum), 5) = Data(i, 2)
      Kq(sNum)(x(sNum), 6) = Data(i, 3)
      Kq(sNum)(x(sNum), 7) = Data(i, 6)
      Kq(sNum)(x(sNum), 8) = Data(i, 4)
   End If
Sheets("BG KhoCN").[A28].Resize(x(1), 8) = Kq(1)
Sheets("BG KhoCN").[A28].Resize(x(2), 8) = Kq(2)

Hoặc là:

Type MULARR
  ar() As Variant
  ln As Integer
End Type

sub xyz()
Dim Kq(1 To 2) As MULARR
Dim Data(), i, sNum
Data = Sheet3.Range("B9", Sheet3.[G65536].End(3)).Value
ReDim Kq(1).ar(1 To UBound(Data), 1 To 8)
ReDim Kq(2).ar(1 To UBound(Data), 1 To 8)
For i = 1 To UBound(Data)
   sNum = IIf(Data(i, 5) = "Kho CN", 1, IIf(Data(i, 5) = "Kho KV", 2, 0))
   If sNum Then
      Kq(sNum).ln = Kq(sNum).ln + 1
      Kq(sNum).ar(Kq(sNum).ln, 1) =  Kq(sNum).ln
      Kq(sNum).ar(Kq(sNum).ln, 2) = Data(i, 1)
      Kq(sNum).ar(Kq(sNum).ln, 5) = Data(i, 2)
      Kq(sNum).ar(Kq(sNum).ln, 6) = Data(i, 3)
      Kq(sNum).ar(Kq(sNum).ln, 7) = Data(i, 6)
      Kq(sNum).ar(Kq(sNum).ln, 8) = Data(i, 4)
   End If
Sheets("BG KhoCN").[A28].Resize(Kq(1).ln, 8) = Kq(1).ar
Sheets("BG KhoCN").[A28].Resize(Kq(2).ln, 8) = Kq(2).ar
end sub

Mình thử test thấy thiếu một Chữ Next và lỗi dòng "Sheets("BG KhoKV").[A28].Resize(Kq(2).ln, 8) = Kq(2).ar"

 

[VetMini]

Mình thử test thấy thiếu một Chữ Next và lỗi dòng "Sheets("BG KhoKV").[A28].Resize(Kq(2).ln, 8) = Kq(2).ar"

Ờ đúng rồi. Code còn nhièu chỗ sai lắm. Tôi chỉ cốt yếu diễn tả cách dùng mảng trong mảng thôi.