|
Sub match_more()
Dim iSourceRow As Long
Dim iSourceCol As Integer
Dim iDealRow As Integer
Dim iDealCol As Integer
Dim iRep
Dim iCol As Integer
Dim i, j, k As Long
Dim ifound As Integer
iRep = InputBox("Please input the source data first column number(1,2,3...):", "input column number")
If iRep = "" Then
MsgBox "You need input a value in input box!", vbInformation, "Input"
End
End If
If Not IsNumeric(iRep) Then
MsgBox "You need input the integer value!", vbInformation, "Input Number"
End
End If
iCol = iRep
If iCol < 3 Then
MsgBox "You need put the source data after the data you need deal with!", vbInformation, "Put after"
End
End If
Cells(1, 1).CurrentRegion.Select
iDealRow = Selection.Rows.Count
iDealCol = Selection.Columns.Count
Cells(1, iCol).CurrentRegion.Select
iSourceRow = Selection.Rows.Count
iSourceCol = Selection.Columns.Count
Cells(1, iDealCol + 1) = "Deal"
Cells(1, iCol + iSourceCol) = "Source"
For i = 2 To iDealRow
Cells(i, iDealCol + 1) = i - 1
Next i
For i = 2 To iSourceRow
Cells(i, iCol + iSourceCol) = i - 1
Next i
Range(Cells(1, 1), Cells(iDealRow, iDealCol + 1)).Select
Selection.Sort Key1:=Cells(2, 1), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range(Cells(1, iCol), Cells(iSourceRow, iCol + iSourceCol)).Select
Selection.Sort Key1:=Cells(2, iCol), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range(Cells(1, iCol), Cells(1, iCol + iSourceCol - 1)).Select
Selection.Copy
Cells(1, iCol + iSourceCol + 2).Select
Cells(1, iCol + iSourceCol + 2 + iSourceCol) = "Deal"
ActiveSheet.Paste
Application.CutCopyMode = False
k = 2
ifound = 0
For i = 2 To iDealRow
ifound = 0
For j = k To iSourceRow
If Cells(i, 1) = Cells(j, iCol) Then
Range(Cells(j, iCol), Cells(j, iCol + iSourceCol - 1)).Select
Selection.Copy
Cells(i, iCol + iSourceCol + 2).Select
Cells(i, iCol + iSourceCol + 2 + iSourceCol) = Cells(i, iDealCol + 1)
ActiveSheet.Paste
Application.CutCopyMode = False
ifound = 1
k = j
Exit For
End If
Next j
If ifound = 0 Then
Cells(i, iCol + iSourceCol + 2) = "Not found"
Cells(i, iCol + iSourceCol + 2 + iSourceCol) = Cells(i, iDealCol + 1)
Else
ifound = 0
End If
Application.StatusBar = "Finished " & Format(i / iDealRow * 100, "0.00") & "%"
Next i
Range(Cells(1, 1), Cells(iDealRow, iDealCol + 1)).Select
Selection.Sort Key1:=Cells(2, iDealCol + 1), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range(Cells(1, iCol), Cells(iSourceRow, iCol + iSourceCol)).Select
Selection.Sort Key1:=Cells(2, iCol + iSourceCol), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range(Cells(1, iCol + iSourceCol + 2), Cells(iSourceRow, iCol + iSourceCol + 2 + iSourceCol)).Select
Selection.Sort Key1:=Cells(2, iCol + iSourceCol + 2 + iSourceCol), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Columns(iDealCol + 1).Clear
Columns(iCol + iSourceCol).Clear
Columns(iCol + iSourceCol + 2 + iSourceCol).Clear
Application.StatusBar = False
End Sub
|
|