Cách này thì có tự động được không bác, bấm nút ra ngay kế quả ý bác.
Nối lại chỉ là 1 phần công việc, chưa phải kết quả cuối. Phần tiếp theo là lập trình trên bảng đã nối để ra kết quả sheet còn lại. Phần sau này tác giả không hỏi
Dạ cháu đã hiểu và chưa làm được vì chưa học món "bao ờ quoe di" này. Món này có vẻ thơm, chắc bác Vẹt cũng nghiền món này?
Dạ phần sau con đã biết rồi chú, con chỉ muốn dùng VBA vì Power Query con chưa biết một chút gì hết. Hihi
- Khai báo 3 mảng 1, 2 và 3
thì đúng là cách này rồi còn gì bác, uổi mà ghép mảng xong không biết cái nào là xuất, cái nào là nhập, cho vào nấu cháo một đám sợ ăn không ngon. mà để ý là bài 4 tự nhiên nảy ra thêm một cột mới nữa.
Bài 4 add thêm 1 cột bằng Power query chứ ở đâu ra.
Bài #9 chỉ mách cho kỹ thuật nối mảng. Dữ liệu bị lộn xộn là lỗi của bạn. Có đến vài cách phân biệt:
Tự nhiên đòi hỏi ghép 2 vùng vào 1 mảng cho luxubu.
Option Explicit
Public Sub Gpe()
Dim sArr(), dArr(1 To 1000, 1 To 4), SP As String
Dim I As Long, K As Long, R As Long, fDay As Long, eDay As Long
With Sheets("NXT")
fDay = .Range("B2").Value
eDay = .Range("B3").Value
SP = .Range("B4").Value
'============================= Nhap'
sArr = Sheets("Nhap").Range("A4", Sheets("Nhap").Range("A10000").End(xlUp)).Resize(, 4).Value
R = UBound(sArr)
If R > 1 Then
For I = 2 To R
If sArr(I, 1) >= fDay Then
If sArr(I, 1) <= eDay Then
If sArr(I, 2) = SP Then
K = K + 1
dArr(K, 1) = sArr(I, 1)
dArr(K, 2) = sArr(I, 3)
dArr(K, 3) = sArr(I, 4)
End If
End If
End If
Next I
End If
'============================= Xuat'
sArr = Sheets("Xuat").Range("A4", Sheets("Xuat").Range("A10000").End(xlUp)).Resize(, 4).Value
R = UBound(sArr)
If R > 1 Then
For I = 2 To R
If sArr(I, 1) >= fDay Then
If sArr(I, 1) <= eDay Then
If sArr(I, 2) = SP Then
K = K + 1
dArr(K, 1) = sArr(I, 1)
dArr(K, 2) = sArr(I, 3)
dArr(K, 4) = sArr(I, 4)
End If
End If
End If
Next I
End If
'======================================NXT'
.Range("A7:D1000").ClearContents
.Range("A7:D1000").Borders.LineStyle = 0
If K Then
.Range("A7:D7").Resize(K) = dArr
.Range("A7:D7").Resize(K).Borders.LineStyle = 1
.Range("A7:D7").Resize(K).Sort Key1:=.Range("A7"), Order1:=xlAscending
End If
End With
End SubBạn sử lý hai mảng gần như in hệt nhau. Như vậy bạn không cần hai code riêng biệt.
Thầy Ba Tê biết kế toán nhập xuất tồn luôn!
Viết "tanh bành" ra cho khỏi bị hỏi.
Option Explicit
Public Sub Gpe()
Dim sArr(), dArr(1 To 1000, 1 To 4), SP As String, Bang As Variant
Dim I As Long, K As Long, R As Long, fDay As Long, eDay As Long, CotSL As Long
With Sheets("NXT")
fDay = .Range("B2").Value
eDay = .Range("B3").Value
SP = .Range("B4").Value
'============================= Nhap, Xuat'
For Each Bang In Array("Nhap", "Xuat")
sArr = Sheets(Bang).Range("A4", Sheets(Bang).Range("A10000").End(xlUp)).Resize(, 4).Value
R = UBound(sArr)
If R > 1 Then
CotSL = IIf(Bang = "Nhap", 3, 4)
For I = 2 To R
If sArr(I, 1) >= fDay Then
If sArr(I, 1) <= eDay Then
If sArr(I, 2) = SP Then
K = K + 1
dArr(K, 1) = sArr(I, 1)
dArr(K, 2) = sArr(I, 3)
dArr(K, CotSL) = sArr(I, 4)
End If
End If
End If
Next I
End If
Next Bang
'======================================NXT'
.Range("A7:D1000").ClearContents
.Range("A7:D1000").Borders.LineStyle = 0
If K Then
.Range("A7:D7").Resize(K) = dArr
.Range("A7:D7").Resize(K).Borders.LineStyle = 1
.Range("A7:D7").Resize(K).Sort Key1:=.Range("A7"), Order1:=xlAscending
End If
End With
End SubTôi thấy tác giả đã biết ở đâu đó code của 1 bài tương tự, kết quả tương tự hình bài #1, nhưng bài đó chỉ có 1 bảng nhập xuất. Tức 1 cái là của bản thân lại là 2 bảng, chỉ cần gộp 2 bảng làm 1 (sort siếc cái nữa), thì áp dụng code bài đã biết là xong. Tác giả cũng đã xác nhận vụ này ở bài #8
Tránh tình trạng xuất kho âm, cùng ngày phải nhập phiếu nhập kho trước, sau đó mới nhập phiếu xuất kho
Sub XYZ()
Dim sArr(), aXuat(), aCol, Res()
Dim SP$, fday As Date, eDay As Date, sRow&, i&, k&
aCol = Array(Array("Nhap", 0, 3), Array("Xuat", 0, 4))
With Sheets("NhapXuatTon")
fday = .Range("B2").Value: eDay = .Range("B3").Value
SP = .Range("B4").Value
For n = 0 To 1
aCol(n)(1) = Sheets(aCol(n)(0)).Range("A" & Rows.Count).End(xlUp).Row - 4
Next n
ReDim Res(1 To aCol(0)(1) + aCol(1)(1), 1 To 4)
For n = 0 To 1
sRow = aCol(n)(1)
sArr = Sheets(aCol(n)(0)).Range("A5").Resize(sRow, 4).Value
For i = 1 To sRow
If sArr(i, 2) = SP Then
If sArr(i, 1) >= fday Then
If sArr(i, 1) <= eDay Then
k = k + 1
Res(k, 1) = sArr(i, 1): Res(k, 2) = sArr(i, 3)
Res(k, aCol(n)(2)) = sArr(i, 4)
End If
End If
End If
Next i
Next n
i = .Range("A" & Rows.Count).End(xlUp).Row
If i > 6 Then .Range("A7:D" & i).Clear
If k Then
.Range("B7").Resize(k).NumberFormat = "@"
.Range("A7:D7").Resize(k) = Res
.Range("A7:D7").Resize(k).Borders.LineStyle = 1
.Range("A7:D7").Resize(k).Sort .Range("A7"), 1, .Range("C7"), , 1
End If
End With
End Sub
Tôi nghĩ như thế này nhanh hơn:
