Giúp đỡ hoàn thiện bài toán về quản lý vật tư công trình trong công ty xây dựng nhỏ

  • Thread starter Thread starter y2k_mqm
  • Ngày gửi Ngày gửi
Liên hệ QC

y2k_mqm

Thành viên mới
Tham gia
11/2/12
Bài viết
13
Được thích
0
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ỏ :D. 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 đỡ :D.
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



ead173448431c205348fd2c060355d22_41001697.update.png
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 -\\/. )
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


96bfc0752eb347e1cb6bcca17eabed99_41001745.ideas.png


ead173448431c205348fd2c060355d22_41001697.update.png
 

File đính kèm

Rất mong mọi người bớt chút thời gian giúp đỡ và hoàn thiện giúp em. Em rất mong các bác vào góp ý giúp đỡ. Thanks
 
Lần chỉnh sửa cuối:
Upvote 0
Mong các bác cao thủ về VB giúp đỡ để em hoàn thiện bài toán với ạ. Về mục công trình phần sắp xếp theo thứ tự ngày tháng. Em đã thêm được đoạn code vào sau code của bác concogia để sắp xếp theo thứ tự ngày tháng. Tuy nhiên code của em chưa phải là code tối ưu thì chỉ mới bắt được các công trình đã có sẵn. Đoạn code này bất cập ở chỗ khi ta thêm các sheet" Công trình..." khác thì lại phải vào code VB và edit thêm vào. :(
Mã:
If ActiveSheet.Name = "Congtrinh x" Or ActiveSheet.Name = "Congtrinh y" Or ActiveSheet.Name = "Congtrinh z" Then
Worksheets(ActiveSheet.Name).Sort.SortFields.Clear
Worksheets(ActiveSheet.Name).Sort.SortFields.Add Key:=Range( _
"C5:C50000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With Worksheets(ActiveSheet.Name).Sort
.SetRange Range("C4:J19")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("C5").Select
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom