Đoạn Code VBA này dùng làm gì đây ?

Thảo luận trong 'Ứng dụng Excel' bắt đầu bởi SA_DQ, 18 Tháng bảy 2005.

2,626 lượt xem

  1. SA_DQ

    SA_DQ Thành viên thân thiết

    Bài viết:
    433
    Đã được thích:
    38
    Nơi ở:
    HCM city
    VB làm gì đây?

    Sub BCNgay()
    On Error GoTo Loi_BCNgay
    Const BDau = 5

    Dim SMA As Integer, SMB As Integer, SMC As Integer, SMD As Integer
    Dim VtriD As Integer, VTriG As Integer, VTriC As Integer
    Dim NgaySX, MVTr As Integer, SMe As Integer
    Dim BDNgay As Integer, CuoiKy As Integer
    Dim TTCa As String, CaD As String, CaG As String, CaC As String
    ReDim MChu(1 To 3) As String
    100 '. Bước 1
    Sheets("BC").Select: Cells.Select
    Selection.EntireRow.Hidden = False
    For ii = 1 To 3
    SMA = 5 + 11 * (ii - 1)
    Chu = "A" & CStr(SMA) & ":W" & CStr(SMA + 9): Range(Chu).Select
    Selection.ClearContents
    For SMB = SMA To (SMA + 9)
    Chu = "B" & CStr(SMB): Range(Chu).Select
    ActiveCell.Value = "S"
    Next SMB
    Next ii
    101 '. Bước 2 :banana:
    Range("K1").Select 'VTrí Ghi Ngày BC:
    NgaySX = ActiveCell.Value
    If CVDate(NgaySX) > #7/13/2007# Then Exit Sub
    Sheets("CSDL").Select: Columns("A:Y").Select
    'A2: Ngaøy ; C2: Soá meû
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,Key2:=Range("C2") _
    , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= False, Orientation:=xlTopToBottom
    102 '. Bước 3 :biggrin:
    Columns("A:Y").Select
    Range("A1:Y932").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
    "AA1:AY2"), CopyToRange:=Columns("BA:BY"), Unique:=False
    103 '.
    ii = 1: BDNgay = 0
    SMA = 0: SMB = 0
    SMC = 0: SMD = 0
    TTCa = "?"
    Do
    ii = 1 + ii
    Chu = "A" & CStr(ii): Range(Chu).Select 'A: Cột NgàySX
    If ActiveCell.Value = 0 Or ActiveCell.Value > NgaySX Then
    CuoiKy = ii - 1: Exit Do
    End If
    If ActiveCell.Value = NgaySX Then
    If BDNgay = 0 Then BDNgay = ii
    Chu = "B" & CStr(ii): Range(Chu).Select 'B: Coät CaSX
    104 '.
    If UCase$(ActiveCell.Value) = "A" Then SMA = 1 + SMA
    If UCase$(ActiveCell.Value) = "B" Then SMB = 1 + SMB
    If UCase$(ActiveCell.Value) = "C" Then SMC = 1 + SMC
    If UCase$(ActiveCell.Value) = "D" Then SMD = 1 + SMD
    If UCase$(ActiveCell.Value) <> Left(TTCa, 1) Then
    TTCa = UCase$(ActiveCell.Value) & TTCa
    End If
    End If
    Loop
    105 '. :
    CaD = Mid(TTCa, 3, 1): CaC = Left(TTCa, 1)
    CaG = Mid(TTCa, 2, 1): If Len(TTCa) < 2 Then Exit Sub ' Function
    106 '. :
    VtriD = Choose(Asc(CaD) - 64, SMA, SMB, SMC, SMD)
    VTriG = Choose(Asc(CaG) - 64, SMA, SMB, SMC, SMD)
    VTriC = Choose(Asc(CaC) - 64, SMA, SMB, SMC, SMD)
    ii = BDNgay + VtriD - 1
    MChu(1) = "B" & CStr(BDNgay) & ":X" & CStr(ii) 'X: Coät cuoái CSDL
    ii = 1 + ii
    MChu(2) = "B" & CStr(ii) & ":X" & CStr(ii + VTriG - 1) ' Ntr
    ii = ii + VTriG
    MChu(3) = "B" & CStr(ii) & ":X" & CStr(ii + VTriC - 1) ' Ntr
    MVTr = BDau ' Không thể chuyển thông số bằng biến mãng được!
    107 '. :
    For ii = 1 To 3
    Sheets("CSDL").Select: Range(MChu(ii)).Select
    Selection.Copy:
    Sheets("BC").Select: Chu = "A" & CStr(MVTr)
    Range(Chu).Select: ActiveSheet.Paste
    Application.CutCopyMode = False
    SMe = Choose(ii, VtriD, VTriG, VTriC)
    MVTr = 11 + MVTr
    108 '. :
    TongCa MVTr, SMe
    Next ii

    For ii = 1 To 3
    VtriD = Choose(ii, 36, 25, 14)
    VTriC = Choose(ii, 27, 16, 5)
    For SMe = VtriD To VTriC Step -1
    Chu = "B" & CStr(SMe): Range(Chu).Select ' 'B': Số mẽ
    If Len(ActiveCell.Value) < 2 Then
    Chu = CStr(SMe) & ":" & CStr(SMe)
    Rows(Chu).Select
    1080 Selection.EntireRow.Hidden = True
    Else
    Exit For
    End If
    Next SMe
    Next ii
    Range("D9").Select
    Sheets("CSDL").Select
    Chu = "BA" & CStr(CuoiKy + 1) & ":BZ999": Range(Chu).Select
    Selection.ClearContents
    Sheets("BC").Select

    Err_BCNgay: Exit Sub
    Loi_BCNgay: Select Case Err
    Case 5, 94, 1004
    Resume Next
    Case Else
    Chu = CStr(Err) & ": " & Error$() & "; Dong: " & Str(Erl)
    End Select
    MsgBox Chu: Resume Err_BCNgay
    End Sub
     
    Last edited: 5 Tháng tám 2005
    #1
  2. SA_DQ

    SA_DQ Thành viên thân thiết

    Bài viết:
    433
    Đã được thích:
    38
    Nơi ở:
    HCM city
    Thay đổi đề tài thôi!

    Cho gởi nhờ giúp lưu dùm đoạn mã với nha!
     
    #2
  3. SA_DQ

    SA_DQ Thành viên thân thiết

    Bài viết:
    433
    Đã được thích:
    38
    Nơi ở:
    HCM city
    Đố Vui Có Khen!

    Các Bạn thử đoán xem các bước trong đoạn mã trên làm những gi?
     
    Last edited: 5 Tháng tám 2005
    #3

Chia sẻ trang này