Sau khi nghiền ngẫm về bài toán của mình. Em đã gần hoàn thiện được bảng excel về quản lý vật tư công trình và tồn nợ đại lý dùng cho công ty xây dựng nhỏ . Nhưng vẫn còn một vài vướng mắc mong các bác "gội rồi mới cạo" giúp đỡ .
Em làm một phần mục lục bằng VB( có tham khảo code trên mạng) nhưng đang bị lỗi không "Back to index" khi click vào Back to index trên các sheet.
Một là về phần công trình em muốn sắp xếp lần lượt theo thứ tự ngày tháng. Ở đây đang là sắp xếp theo đại lý
(Sử dụng code của bác concogia)
Hai là em có thêm 1 sheet tổng hợp về xe chở . Dữ liệu cũng được update vào sheet này khi ta nhập dữ liệu ở các sheet Đại lý. ( Em muốn trình bày phần xe chở giống theo cách của bác Caomanhson đã bày nhưng thay bằng X C là tên các xe và các nội dung như sheet tổng hợp về xe chở)
( Code của bác Cao Mạnh Sơn đang lỗi về phần tự update dữ liệu )
Em làm một phần mục lục bằng VB( có tham khảo code trên mạng) nhưng đang bị lỗi không "Back to index" khi click vào Back to index trên các sheet.
Mã:
Mã:
Private Sub Worksheet_Activate()
Dim wSheet As Worksheet
Dim M As Long
M = 1
With Me
.Columns(1).ClearContents
.Cells(1, 1) = "INDEX"
.Cells(1, 1).Name = "Index"
End With
For Each wSheet In Worksheets
If wSheet.Name <> Me.Name Then
M = M + 1
With wSheet
.Range("H1").Name = "Start" & wSheet.Index
.Hyperlinks.Add Anchor:=.Range("H1"), Address:="", SubAddress:="Mucluc", TextToDisplay:="Back to Index"
End With
Me.Hyperlinks.Add Anchor:=Me.Cells(M, 1), Address:="", SubAddress:="Start" & wSheet.Index, TextToDisplay:=wSheet.Name
End If
Next wSheet
End Sub
Một là về phần công trình em muốn sắp xếp lần lượt theo thứ tự ngày tháng. Ở đây đang là sắp xếp theo đại lý
(Sử dụng code của bác concogia)
Mã:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim Vung, I As Integer, J As Integer, K As Integer, TenDL, TenCT, Mg()
TenCT = Split(ActiveSheet.Name)
If TenCT(0) = "Congtrinh" Then
ActiveSheet.[C5:J50000].ClearContents
For Each Sh In Worksheets
TenDL = Split(Sh.Name)
If TenDL(0) = "Daily" Then
Vung = Sh.Range(Sh.[C6], Sh.[C50000].End(xlUp)).Resize(, 8)
ReDim Mg(1 To UBound(Vung), 1 To 8)
For I = 1 To UBound(Vung)
If Vung(I, 8) = TenCT(UBound(TenCT)) Then
K = K + 1
For J = 1 To 7
Mg(K, J) = Vung(I, J)
Next J
Mg(K, 8) = TenDL(1)
End If
Next I
End If
[C50000].End(xlUp)(2).Resize(UBound(Mg), 8) = Mg
K = 0
Next Sh
End If
End Sub
( Code của bác Cao Mạnh Sơn đang lỗi về phần tự update dữ liệu )
Mã:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sh As Worksheet, Sh0 As Worksheet
Dim Clls As Range, Rng As Range
Application.ScreenUpdating = False
Application.Calculation = xlManual
If Not Intersect(Target, Range("$F$2")) Is Nothing Then
With Target
Set Sh0 = Sheets("TongHopCongTrinh")
Sh0.AutoFilterMode = False
Sh0.Range("B6:H" & Sh0.[C65500].End(xlUp).Row + 100).Clear
For Each Sh In Worksheets
If Sh.Name <> Sh0.Name Then
Sh.AutoFilterMode = False
Sh.Select
Sh.Copy After:=Sheets(Sheets.Count)
Set Rng = Sheets(Sheets.Count).Range("C4:I" & Sh.[D65500].End(xlUp).Row)
Set Clls = [Sh0].Range("B" & Sh0.[C65500].End(xlUp).Row).Offset(1)
With Rng
.UnMerge
For Each cell In Rng.Resize(, 1)
If cell.Value = 0 Then
cell.Value = cell.Offset(-1).Value
End If
Next
.AutoFilter 7, Criteria1:=Target
.Offset(1).Resize(, 6).SpecialCells(12).Copy: Clls.PasteSpecial 3
Range("H" & Sh0.[H65500].End(xlUp).Row + 1 & ":H" & Sh0.[C65500].End(xlUp).Row).Value = Sh.Name
Application.DisplayAlerts = False
Sheets(Sheets.Count).Delete
End With
End If
Next Sh
Target.Select
End With
Sh0.Range("B6").CurrentRegion.Borders.Weight = xlThin
Sh0.Range("B6").CurrentRegion.Resize(, 1).NumberFormat = "dd/mm/yyyy"
Sh0.Range("B6").CurrentRegion.Offset(, 3).Resize(, 3).NumberFormat = "#,###"
End If
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub