Option Explicit
Dim smallrng As Range
Dim MyRg As Range
Dim irEnd As Integer 'khai bao bien interger cua row cuoi cua destination extract
Sub QuyetToanChi_RpOpen()
' Macro recorded 15-10-2007 by MR
'D:\PTC\Accounting\BalanceSheet\Report\200709QToan Chi_Rp.xls
'D:\PTC\Accounting\BalanceSheet\Report\QToanChi_Rp .xls
Workbooks.Open Filename:="D:\PTC\Accounting\BalanceSheet\Report\QToanChi_Rp.xls"
End Sub
Sub CloseMe()
ThisWorkbook.Close True
End Sub
Sub Main()
QuyetToanChi_RpOpen
' Tim dong cuoi cua destination extract
With Worksheets("QToanChi")
irEnd = .Range("a4").End(xlDown).Row
End With
Input1RowFormula
FillDown (irEnd)
CopyValue (irEnd)
MyTypeDelete_CellDuplicateInColumn (irEnd)
MyTypeDCellDupC (irEnd)
MyTypeDCellDupC_I (irEnd)
End Sub
'- Buoc 2: la filter tai file data cac so lieu (record) cua C Chi,
' nho phai danh so lai dung thu tu cot (mau do)de dung trong vlookup
'- Buoc 3: copy phan data da filter vao file report quyet toan Chi,
' luu y den ID record, o day copy den cot so 29
' Close file data de nhe may
'Dat vung Data (Name) o Sheet Source, copy ID Record da loc sang sheet QToan Chi
'Kiem tra, copy dong tieu de co chua ca so ID cot giua 2 Sheet Source va Destination
Sub Input1RowFormula()
Dim sPartFormula As String, sPF2 As String
sPartFormula = "=VLOOKUP($A4,Data,"
sPF2 = ",0)"
Windows("QToanChi_Rp.xls").Activate
With Workbooks("QToanChi_Rp.xls").Worksheets("QToanChi")
'.DisplayZeros = False 'record:ActiveWindow.DisplayZeros = False
.Range("L4").FormulaR1C1 = "=RC[-2]*RC[-1]"
Set MyRg = .Range("b4:f4,h4:k4,m4")
For Each smallrng In MyRg
With smallrng
.Formula = sPartFormula & .Offset(-2, 0) & sPF2
End With
Next smallrng
End With
Sheets("QToanChi").Activate
'FillDown (lrEnd) de o day se bao bien chua khai bao
End Sub
Sub FillDown(irEnd As Integer)
' Macro recorded 15-10-2007 by MR
Range("B4:M4").AutoFill Destination:=Range("B4:M" & irEnd), Type:=xlFillDefault
End Sub
Sub CopyValue(irEnd As Integer)
Set MyRg = Range("B4:M" & irEnd)
'Trong case nay ta kg dung them for each van ok
With MyRg
.Value = .Value
End With
Set MyRg = Nothing
End Sub
Sub MyTypeDelete_CellDuplicateInColumn(irEnd As Integer)
Dim j As Integer, i As Integer
'Dung cu phap rngData.Cells(i,k) de chon cell tuong doi trong rngData, va bat dau tu 1
Set MyRg = Range("c4:c" & irEnd)
i = 1
j = i + 1
'Cells(1, 3) = rngData.Rows.Count = number 17
For j = 2 To MyRg.Rows.Count
With MyRg
If .Cells(j, 1) = .Cells(i, 1) Then
.Cells(j, 1) = ""
.Cells(j, 1).Offset(0, -1) = ""
'.Cells(j, 1).Offset(0, 8) = ""
'.Cells(j, 1).Offset(0, 9) = ""
Else
i = j
End If
End With
Next j
Set MyRg = Nothing
End Sub
Sub MyTypeDCellDupC(irEnd As Integer)
'Origine code From nvs GPE
Dim j As Integer, i As Integer
Set MyRg = Range("f4:f" & irEnd)
i = 1
j = i + 1
For j = 2 To MyRg.Rows.Count
With MyRg
If .Cells(j, 1) = .Cells(i, 1) And .Cells(j, 3) = .Cells(i, 3) Then
.Cells(j, 1) = ""
.Cells(j, 2) = ""
.Cells(j, 3) = ""
'.Cells(j, 1).Offset(0, 8) = ""
'.Cells(j, 1).Offset(0, 9) = ""
Else
i = j
End If
End With
Next j
Set MyRg = Nothing
End Sub
Sub MyTypeDCellDupC_I(irEnd As Integer)
Dim j As Integer, i As Integer
'Dung cu phap rngData.Cells(i,k) de chon cell tuong doi trong rngData, va bat dau tu 1
Set MyRg = Range("i4:i" & irEnd)
i = 1
j = i + 1
'Cells(1, 3) = rngData.Rows.Count = number 17
For j = 2 To MyRg.Rows.Count
With MyRg
If .Cells(j, 1) = .Cells(i, 1) Then
.Cells(j, 1) = ""
'.Cells(j, 1).Offset(0, -1) = ""
'.Cells(j, 1).Offset(0, 8) = ""
'.Cells(j, 1).Offset(0, 9) = ""
Else
i = j
End If
End With
Next j
Set MyRg = Nothing
End Sub
Sub NameData()
' NameData Macro
' Macro recorded 15-10-2007 by MR
Workbooks("QToanChi_Rp").Names.Add Name:="Data", RefersToR1C1:="=Source!R4C1:R33C29"
End Sub
Sub NameDelete()
' NameDelete Macro
' Macro recorded 15-10-2007 by MR
Workbooks("QToanChi_Rp").Names("Data").Delete
End Sub
