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
Góp ý cho bạn: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 ạ
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 ạ
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