Nhờ trợ giúp về cơ sở dữ liệu

[monganh22]

Xin chào mọi người,

Khi mình nhập dữ liệu trong DATABASE sheet xong.
Mình cần tạo một bảng trong sheet 'PRINT'

Khi mình click vào button 'Clear data' thì nó sẽ xóa toàn bộ dữ liệu trong sheet 'PRINT' (từ row 2 to end)

Khi mình click vào button 'Click me' thì data nó như trong sheet 'Print'

Yêu cầu (dữ liệu lấy trong sheet 'DATABASE'):
Nếu Flight No có column D = 'Yes' thì sẽ thêm 1 row (Flight No +1), STD: blank, SECTOR: DEST-DOH
Nếu Flight No có column D = 'No' thì STD= STD trong DATABASE sheet, SECTOR: DOH-DEST (trong database sheet)

Mỗi filght cách nhau 1 hàng trống. Tuy nhiên nếu Flight No có column D = 'Yes' không cách nhau hàng trống nào cả



Xin cảm ơn mọi người

 

[Hoang2013]

Hai macro bạn cần có đây, xin mời:

Sub XoaSach()
 Dim Rws As Long
 Rws = [A65500].End(xlUp).Row
 Range("A2:C" & Rws).Clear
End Sub

Sub YêuEm()
 Dim Rws As Long, J As Long, W As Long, Num As Long, DD As Byte
 Dim Arr()

 With Sheets("Database").[A2]
    Rws = .CurrentRegion.Rows.Count
    MsgBox Rws
    Arr() = .Resize(Rws, 4).Value
 End With
 ReDim dArr(1 To 3 * Rws, 1 To 4)
 For J = 1 To Rws - 1
    If Arr(J, 4) = "Yes" Then
        W = W + 1:                      dArr(W, 1) = Arr(J, 1)
        dArr(W, 2) = Arr(J, 3):         dArr(W, 3) = "DON-" & Arr(J, 2)
        DD = Len(Arr(J, 1))
        Num = CLng(Mid(Arr(J, 1), 3, DD)) + 1
        dArr(W + 1, 1) = Left(Arr(J, 1), 2) & Right("0000" & CStr(Num), DD - 2)
        dArr(W + 1, 3) = Arr(J, 2) & "-DON"
        W = W + 2
    End If
    If Arr(J, 4) = "No" Then
        W = W + 1:                      dArr(W, 1) = Arr(J, 1)
        dArr(W, 2) = Arr(J, 3):         dArr(W, 3) = "DON-" & Arr(J, 2)
        W = W + 1
    End If
 Next J
 If W Then
    [A2].Resize(W, 3).Value = dArr()
    [B2].Resize(W).NumberFormat = "h:mm;@"
 End If
End Sub

 

[monganh22]

Hai macro bạn cần có đây, xin mời:

Sub XoaSach()
 Dim Rws As Long
 Rws = [A65500].End(xlUp).Row
 Range("A2:C" & Rws).Clear
End Sub

Sub YêuEm()
 Dim Rws As Long, J As Long, W As Long, Num As Long, DD As Byte
 Dim Arr()

 With Sheets("Database").[A2]
    Rws = .CurrentRegion.Rows.Count
    MsgBox Rws
    Arr() = .Resize(Rws, 4).Value
 End With
 ReDim dArr(1 To 3 * Rws, 1 To 4)
 For J = 1 To Rws - 1
    If Arr(J, 4) = "Yes" Then
        W = W + 1:                      dArr(W, 1) = Arr(J, 1)
        dArr(W, 2) = Arr(J, 3):         dArr(W, 3) = "DON-" & Arr(J, 2)
        DD = Len(Arr(J, 1))
        Num = CLng(Mid(Arr(J, 1), 3, DD)) + 1
        dArr(W + 1, 1) = Left(Arr(J, 1), 2) & Right("0000" & CStr(Num), DD - 2)
        dArr(W + 1, 3) = Arr(J, 2) & "-DON"
        W = W + 2
    End If
    If Arr(J, 4) = "No" Then
        W = W + 1:                      dArr(W, 1) = Arr(J, 1)
        dArr(W, 2) = Arr(J, 3):         dArr(W, 3) = "DON-" & Arr(J, 2)
        W = W + 1
    End If
 Next J
 If W Then
    [A2].Resize(W, 3).Value = dArr()
    [B2].Resize(W).NumberFormat = "h:mm;@"
 End If
End Sub

Thank you very much

 

[trung984]

Hai macro bạn cần có đây, xin mời:

Sub XoaSach()
 Dim Rws As Long
 Rws = [A65500].End(xlUp).Row
 Range("A2:C" & Rws).Clear
End Sub

Sub YêuEm()
 ...................................
End Sub

Thấy Sub này em thích anh rồi đó.
Sub YêuEm()

 

[SA_DQ]

Rút gọn lúc rỗi nè:

Sub Yêu_Em_Nha_Anh()
 Dim Rws As Long, J As Long, W As Long, Num As Long, DD As Byte, Tmr As Double
 Dim Arr()

 Tmr = Time()
 With Sheets("Database").[A2]
    Rws = .CurrentRegion.Rows.Count
    Arr() = .Resize(Rws, 4).Value
 End With
 ReDim dArr(1 To 3 * Rws, 1 To 4)
 For J = 1 To Rws - 1
    W = W + 1:                          dArr(W, 1) = Arr(J, 1)          '*'
    dArr(W, 2) = Arr(J, 3):             dArr(W, 3) = "DON-" & Arr(J, 2) '*'
    If Arr(J, 4) = "Yes" Then
        DD = Len(Arr(J, 1))
        Num = CLng(Mid(Arr(J, 1), 3, DD)) + 1
        dArr(W + 1, 1) = Left(Arr(J, 1), 2) & Right("0000" & CStr(Num), DD - 2)
        dArr(W + 1, 3) = Arr(J, 2) & "-DON"
        W = W + 1
    End If
    W = W + 1
 Next J
 If W Then
    [A2].Resize(W, 3).Value = dArr():   [B2].Resize(W).NumberFormat = "h:mm;@"
    MsgBox Timer() - Tmr, , "GPE.COM Xin Chào!"
 End If
End Sub